Return to DIBT.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIBT.m, revision 1.1.1.1

1.1       snw         1: DIBT   ;SFISC/GFT,TKW-STORE A SORT TEMPLATE ;8/24/94  13:04
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4: 0      ;
                      5:        S DIC="^DOPT(""DIBT""," G 1:$D(^DOPT("DIBT",.402)) S ^(0)="TEMPLATE FILE^1.01" K ^("B") F X=.4,.401,.402 S ^DOPT("DIBT",X,0)=$P("PRINT^SORT^INPUT",U,$E(X,4)+1)_" TEMPLATE"
                      6:        S DIK=DIC D IXALL^DIK
                      7: 1      ;
                      8:        S DICF=DI,DIC(0)="QEAIN" D ^DIC K DIC Q:Y<0  S DIC=+Y
                      9: 11     W !! Q:$D(DTOUT)  S DIC("S")="I $P(^(0),U,4)="_DICF_",Y'<1",D="F"_DICF
                     10:        S DIC(0)="AEQI" D IX^DIC I Y<0 K DIC,DICF Q
                     11:        S DA=+Y,DIE=DIC,DR=".01:3;5:7;10;707;491620",DIOVRD=1 D ^DIE K DR,DIOVRD G 11
                     12:        ;
                     13: S      ;
                     14:        D S1^DIBT1 K DIRUT,DIROUT G Q^DIP:$D(DUOUT)!($D(DTOUT))
                     15:        G N:X="",S:Y<0
                     16:        S DIBT1=+Y
                     17: SNEW   K ^DIBT(DIBT1,2) S $P(^DIBT(DIBT1,0),U,7)=DT
                     18:        S (DIBT2,DIBT3)=0 F  S DIBT3=$O(DPP(DIBT3)) Q:'DIBT3  S DIBT2=DIBT2+1 D
                     19:        .N DIC,DA,DIE,DINUM,DIOVRD,DR S X=+DPP(DIBT3) Q:'X  S DIC="^DIBT("_DIBT1_",2,",DIC(0)="L",DA(1)=DIBT1,DINUM=DIBT2,DIOVRD=1,DIC("P")=$P(^DD(.401,1621,0),U,2) D FILE^DICN K DIC,DA,DINUM,DIOVRD
                     20:        .N A,B,C,D S $P(^DIBT(DIBT1,2,DIBT2,0),U,2,10)=$P(DPP(DIBT3),U,2,10)
                     21:        .S A="A" F  S A=$O(DPP(DIBT3,A)) Q:A=""  S %=$G(DPP(DIBT3,A)) S:%]"" ^DIBT(DIBT1,2,DIBT2,A)=%
                     22:        .S (C,D)=0 F A=0:0 S A=$O(DPP(DIBT3,A)) Q:'A  D
                     23:        ..I $G(DPP(DIBT3,A))]"" S C=C+1,%=1,%(1)=17,X=A,DINUM=C,DIC("DR")="1////"_DPP(DIBT3,A) D DICM
                     24:        ..S B="" F  S B=$O(DPP(DIBT3,A,B)) Q:B=""  S D=D+1,%=2,%(1)=18,X=A,DINUM=D D DICM S:Y>0 ^DIBT(DIBT1,2,DIBT2,2,+Y,"RCOD")=$P(DPP(DIBT3,A,B),U,4,99)
                     25:        ..Q
                     26:        .S D=0,A="OV" F  S A=$O(DPP(DIBT3,A)) Q:$E(A,1,2)'="OV"  S B="" F  S B=$O(DPP(DIBT3,A,B)) Q:B=""  S C=$G(DPP(DIBT3,A,B)) I C]"" S D=D+1,%=3,%(1)=19,X=A,DINUM=D D DICM I Y>0 S $P(^DIBT(DIBT1,2,DIBT2,3,+Y,0),U,2)=B,^("OVF0")=C
                     27:        .Q
                     28:        I $D(DIBTOLD) K DIBTOLD D K Q
                     29:        S DIBT2=0
                     30: S0     S DIBT2=DIBT2+1 G N:DIBT2>DPP,S0:'$D(DPP(DIBT2,"F")),S0:$P(DPP(DIBT2),U,4)["B"
                     31:        S DIR("?",1)="Answer YES if you want the to allow the user to specify beginning and",DIR("?")="ending sort values when the print job is run."
                     32:        W ! S DIR("A")="SHOULD TEMPLATE USER BE ASKED 'FROM'-'TO' RANGE FOR '"_$P(DPP(DIBT2),U,3)_"'",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DIRUT) D K G Q^DIP
                     33:        G:Y=0 S0
                     34: S1     S ^DIBT(DIBT1,2,DIBT2,"ASK")=1
                     35:        G S0
                     36:        ;
                     37: DICM   S DIC="^DIBT("_DIBT1_",2,"_DIBT2_","_%_",",DA(2)=DIBT1,DA(1)=DIBT2,DIC(0)="L",DIOVRD=1,DIC("P")=$P(^DD(.4014,%(1),0),U,2)
                     38:        N C,D
                     39:        I %(1)=18 S DIC("DR")="1////"_B F C=1,2,3 S D=$P(DPP(DIBT3,A,B),U,C) I D]"" S DIC("DR")=DIC("DR")_";"_(C+1)_"////"_D
                     40:        N A,B,DD,DO D FILE^DICN K DIC,DA,DINUM,DIOVRD Q
                     41:        ;
                     42: US     S $P(^DIBT(DIBT1,0),U,7)=DT I '$O(^DIBT(+$G(DIBT1),2,0)) Q
                     43:        N %,A S X=+$G(DPP(0)),A=0 F X=X:0 S X=$O(DPP(X)) Q:'X  S A=A+1 D
                     44:        .F %="F","T","SER","TXT","IX","PTRIX","QCON","SRTTXT" S:$D(DPP(X,%)) ^DIBT(DIBT1,2,A,%)=DPP(X,%)
                     45:        .Q
                     46:        Q
                     47:        ;
                     48: K      K DIEDT,DIBT2,DIBT3 Q
                     49: N      D K G N^DIP1