Return to DIBT.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIBT.m, revision 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