DIBT ;SFISC/GFT,TKW,TOAD-STORE A SORT TEMPLATE ;06:20 PM  2 Apr 2001
 ;;22.0;VA FileMan;**82**;Nov 17, 1998
 ;Per VHA Directive 10-93-142, this routine should not be modified.
MENU ;
0 ; select and edit templates, until user quits
 S DIC="^DOPT(""DIBT"",",DICF=DI
 I '$D(^DOPT("DIBT",.402)) S ^(0)="TEMPLATE FILE^1.01" K ^("B") D
 .F X=.4,.401,.402 S ^DOPT("DIBT",X,0)=$P(^DIC(X,0),U)
 .N DIK S DIK=DIC D IXALL^DIK
 S DIC(0)="FQEAIN",DIC("A")="Select TEMPLATE File: "
 S DIC("S")="I Y=.4!(Y=.401)!(Y=.402)"
 D ^DIC K DIC Q:Y<0
 K DTOUT F  Q:'$$T(+Y,DICF)  I $D(DTOUT) K DTOUT Q
 Q
 ;
T(DDSFILE,DICF) ;=.4,.401,.402
 N Y,DIC,DIERR,DDSPARM,DR,DA,DIN
 W !! S DIC=DDSFILE,DIC("S")="I $P(^(0),U,4)="_DICF_",Y'<1",D="F"_DICF
 S DIC(0)="AEQI" D IX^DIC I Y<0 Q 0
 S DA=+Y I '$$SCREEN G SCROLL
 S DIN=$S(DDSFILE=.4:"DIPTED",DDSFILE=.402:"DIETED",1:"DIBTED")
 S DR="["_DIN_"]",DDSPARM="E" D ^DDS I '$D(DIERR) Q 1
SCROLL N DIE,DIOVRD,DR
 S DIE=DDSFILE,DR=".01:3;5:7;10;707;491620",DIOVRD=1 D ^DIE Q 1
 ;
SCREEN(HELP) ;
 N DIR,DIRUT,DUOUT,X,Y,DIERR
 K DUZ("SCREEN") ;COMMENT OUT THIS LINE IF YOU WANT FILEMAN TO REMEMBER!
 I $G(DUZ("SCREEN"))=0 Q 0
 D SET^DDGLIB0 I $D(DIERR) Q 0
 I '$G(DUZ("SCREEN")) D
 .S DIR(0)="Y",DIR("A")="Do you want to use the screen-mode version",DIR("B")="YES"
 .I $D(HELP) S DIR("?")=HELP
 .D ^DIR I Y-1 S:Y=0 DUZ("SCREEN")=0 Q
 .S DUZ("SCREEN")=1
 D KILL^DDGLIB0()
 I ^DD("OS")=9 U $I:VT=1 ;FOR DATATREE
 Q +$G(DUZ("SCREEN"))
 ;
S ;
 D S1^DIBT1 K DIRUT,DIROUT G Q^DIP:$D(DUOUT)!($D(DTOUT))
 G N:X="",S:Y<0
 S DIBT1=+Y
SNEW K ^DIBT(DIBT1,2),^("BY0"),^("BY0D") S $P(^DIBT(DIBT1,0),U,7)=DT
 I $G(BY(0))]"",$D(DPP(0)) D
 . N DIBY,DIREC,%,I,D,F,T,Q1,Q2,O S %=DIBT1_"," S DIBY(.401,%,1622)=$P(BY(0),U,2),DIBY(.401,%,1623)=DPP(0)+1 D FILE^DIE("E","DIBY")
 . F I=1:1:DPP(0) D
 .. S F=$P($G(DPP(I,"F")),U,2),T=$P($G(DPP(I,"T")),U,2),O=$P($G(DPP(I)),U,4),Q1="" S:O["!" Q1=Q1_"!" S:O["#" Q1=Q1_"#" S Q2=$P($G(DPP(I)),U,5),O=$G(DPP(I,"OUT"))
 .. S %="+"_I_","_DIBT1_"," K DIBY(.4011624,%)
 .. S:F]"" DIBY(.4011624,%,1)=F S:T]"" DIBY(.4011624,%,2)=T S:Q1]"" DIBY(.4011624,%,3.1)=Q1 S:Q2]"" DIBY(.4011624,%,3.2)=Q2 S:O]"" DIBY(.4011624,%,4)=O
 .. Q:'$D(DIBY(.4011624,%))  S DIBY(.4011624,%,.01)=I,DIREC(I)=I Q
 . D UPDATE^DIE("E","DIBY","DIREC")
 . Q
 S (DIBT2,DIBT3)=+$G(DPP(0)) F  S DIBT3=$O(DPP(DIBT3)) Q:'DIBT3  S DIBT2=DIBT2+1 D
 .N DIC,DA,DIE,DINUM,DIOVRD,DR,DO S X=$P(DPP(DIBT3),U) Q:+$P(X,"E")'=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
 .N A,B,C,D S $P(^DIBT(DIBT1,2,DIBT2,0),U,2,10)=$P(DPP(DIBT3),U,2,10)
 .S A="A" F  S A=$O(DPP(DIBT3,A)) Q:A=""  S %=$G(DPP(DIBT3,A)) S:%]"" ^DIBT(DIBT1,2,DIBT2,A)=%
 .S (C,D)=0 F A=-1:0 S A=$O(DPP(DIBT3,A)) Q:+$P(A,"E")'=A  D
 ..I $G(DPP(DIBT3,A))]"" S C=C+1,%=1,%(1)=17,X=A,DINUM=C,DIC("DR")="1////"_DPP(DIBT3,A) D DICM
 ..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)
 ..Q
 .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
 .Q
 I $D(DIBTOLD) K DIBTOLD D K Q
 S DIBT2=+$G(DPP(0))
S0 S DIBT2=DIBT2+1 G N:DIBT2>DPP,S0:'$D(DPP(DIBT2,"F")),S0:$P(DPP(DIBT2),U,4)["B"
 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."
 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
 G:Y=0 S0
S1 S ^DIBT(DIBT1,2,DIBT2,"ASK")=1
 G S0
 ;
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)
 N C,D
 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
 N A,B,DD,DO D FILE^DICN K DIC,DA,DINUM,DIOVRD Q
 ;
US S $P(^DIBT(DIBT1,0),U,7)=DT I '$O(^DIBT(+$G(DIBT1),2,0)) Q
 N % F X=+$G(DPP(0)):0 S X=$O(DPP(X)) Q:'X  D
 . F %="F","T","SER","TXT","IX","PTRIX","QCON","SRTTXT" K ^DIBT(DIBT1,2,X,%) I $G(DPP(X,%))]"" S:%'="SER" ^DIBT(DIBT1,2,X,%)=DPP(X,%)
 . Q
 Q
 ;
K K DIEDT,DIBT2,DIBT3 Q
N D K G N^DIP1