- DICM0 ;SF/XAK,TKW - LOOKUP WHEN INPUT MUST BE TRANSFORMED ;2/15/00 14:40 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;22.0;VA FileMan;**16,4,20,31**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- P ;Pointers, called by ^DICM1
- S D="" N DICODE,DIASKOK,DIPTRIX
- S DICR(DICR,1)=DIC,DIC=U_$P(DS,U,3),Y=DIC(0),DIC(0)=$TR(Y,"L","")
- S DICR(DICR,2)=$S($$OKTOADD(.DIFILEI,.DINDEX,.DIFINDER):Y,1:DIC(0))
- S DICR(DICR,2.1)=$S($P(DS,U,2)["'":DIC(0),1:Y)
- N:'$D(DIVPSEL) DIVPSEL S DIVPSEL(DICR)=0
- I DIC(0)["B" S DIC(0)=$TR(DIC(0),"M",""),DICR(DICR,2.1)=$TR(DICR(DICR,2.1),"M","")
- S DIC(0)=$TR(DIC(0),"NV","")
- F Y="DR","S","P","W" I $D(DIC(Y)) M DICR(DICR,Y)=DIC(Y) K DIC(Y)
- S DIPTRIX=$G(DIC("PTRIX",DIFILEI,+DINDEX(1,"FIELD"),+$P($P(DS,U,2),"P",2)))
- AST ; Process screens on pointers.
- I $P(DS,U,2)["*",DICR(DICR,2)["L" N DID,DF D
- . F DICODE=" D ^DIC"," D IX^DIC"," D MIX^DIC1" D
- . . S Y=$F(DS,DICODE) Q:'Y
- . . N I S I=$P($E(DS,1,Y-$L(DICODE)-1),U,5,99)
- . . D SETSCR(I,.DICR,.DIC,.D,DICODE,.DID,.DF,+$P($P(DS,U,2),"P",2)) Q
- . Q
- P1 ; Build screen to make sure selected entry is pointed-to.
- S Y="("_DICR(DICR,1) G L1:'$D(DO) K DO I @("$O"_Y_"0))'>0") G L1
- S I="DIC"_DICR,DICODE="X ""I 0"" N "_I D
- . I DINDEX("#")=1,$D(DICR(DICR,"S")) S DICODE=DICODE_",%Y"_DICR
- . S DICODE=DICODE_" F "_I_"=0:0 S "_I_"=$O"_Y,%=""""_%_""""
- D G:DICODE="" L1
- . I $G(DINDEX("#"))>1 D BLDC(Y,%,DINDEX("#"),DIFILEI,"",.DICODE,.DICR) Q
- . I @("$O"_Y_%_",0))>0") S DICODE=DICODE_%_",Y,"_I_")) Q:"_I_"'>0 I $D"_Y_I_",0))"_$$CHKTMP(.DIC,DICR,DIFILEI,I) Q
- . I DS["DINUM=X" S DICODE="I $D"_Y_"Y,0))"_$$CHKTMP(.DIC,DICR,DIFILEI,"Y")_" S "_I_"=Y" Q
- . I $P(DS,U,4)="0;1" S DICODE=DICODE_I_")) Q:"_I_"'>0 I $P(^("_I_",0),U)=Y"_$$CHKTMP(.DIC,DICR,DIFILEI,I) Q
- . S DICODE="" Q
- I DINDEX("#")=1,$D(DICR(DICR,"S")) S DICODE=DICODE_" S %Y"_DICR_"=Y,Y="_I_" X DICR("_DICR_",""S"") S Y=%Y"_DICR_" I "
- S DIC("S")=DICODE_" Q"
- ; If user passed list of indexes for lookup on pointed-to file, set-up.
- I DIPTRIX]"" S D=DIPTRIX D SETIX(.D,.DIC,.DID,.DF,.DICR,+$P($P(DS,U,2),"P",2))
- S:$G(D)="" D="B" S Y=0
- N DS,DINDEX,DIFILEI D X^DIC
- L1 K DIC("S"),@("DIC"_DICR)
- I Y'>0 I $G(DTOUT)!($G(DIROUT)) G R
- I Y'>0,'$D(DICR(DICR,8)) D G RETRY
- . I $G(DICR(DICR,31.2)) S DIC("S")="I Y-"_DICR(DICR,31.2)
- . Q:'$D(DICR(DICR,31))
- . S DIC("S")=$S($D(DIC("S")):DIC("S")_" ",1:"")_DICR(DICR,31) Q
- I DICR(DICR,2)["L",DICR(DICR,2)["E",@("$P("_DIC_"0),U,2)'[""O"""),$P(@(DICR(DICR,1)_"0)"),U,2)'["O",'DIVPSEL(DICR) D G:%-1 L2
- . N I F I=(DICR-1):-1 Q:'$D(DIVPSEL(I)) S DIVPSEL(I)=1
- . S DST=" ...OK",%=1 D Y^DICN W:'$D(DDS) ! Q
- R K DICS,DICW,DO,DIC("W"),DIC("S")
- S DIC=DICR(DICR,1),%=DICR(DICR,2),DIC(0)=$P(%,"M")_$P(%,"M",2)
- F X="DR","S","P","W" I $D(DICR(DICR,X)) M DIC(X)=DICR(DICR,X)
- I $D(DIC("P")),+DIC("P")=.12 S DIC(0)=DIC(0)_"X"
- D DO^DIC1 S X=+Y K:X'>0 X Q
- ;
- L2 G NO:%-2 S DIC("S")="I Y-"_+Y_$S($D(DICR(DICR,31)):" "_DICR(DICR,31),1:""),X=DICR(DICR) W:'$D(DDS) " "_X I $D(DDS),$G(DDH) D LIST^DDSU
- K DST ;
- RETRY D DO^DIC1 K DICR(U,+DO(2))
- S D=$G(DICR(DICR,2.2)) S:D]"" DF=D S:D="" D="B"
- S DIC(0)=DICR(DICR,2.1) S:"^"[X X=DICR(DICR)
- I $D(DIFILEI) N DS,DINDEX,DIFILEI
- I $D(DICR(DICR,31)),$G(DA(1)),'$G(DA) M DS=DA N DA M DA=DS S DA=DA(1) K DS
- I $D(DICR(DICR,31.1)) S DID=DICR(DICR,31.1),DID(1)=2,DF=D
- D X^DIC K DICR(DICR,6)
- G R
- ;
- BLDC(DIGBL,DIXNAM,DIXNO,DIFILEI,DIPGBL,DICODE,DICR) ; Build screening logic to loop through compound index, making sure pointed-to file is pointed-to by entry in index
- N %,I,C,X,Y,DISB S Y="Y"
- I $G(DIPGBL)]"" S Y="(+Y_"";"_$E(DIPGBL,2,99)_""")"
- S %=DIGBL_DIXNAM_","_Y
- S DICODE="N DICROUT,DIC"_DICR D
- . I $D(DICR(DICR,"S")) S DICODE=DICODE_",%Y"_DICR
- . S DICODE=DICODE_" X ""I 0"" I $D"_%_")) S DICROUT=0 X DICR("_DICR_",""SUB"",2)" Q
- F I=2:1:DIXNO S C="N DISB"_I_" S DISB"_I_"="""" " D
- . S C=C_"F S DISB"_I_"=$O"_%_",DISB"_I_")) Q:DISB"_I_"="""" X DICR("_DICR_",""SUB"","_(I+1)_") Q:DICROUT"
- . S DICR(DICR,"SUB",I)=C
- . S %=%_",DISB"_I Q
- S I="DIC"_DICR
- S X="S "_I_"=0 F S "_I_"=$O"_%_","_I_")) Q:'"_I_" I $D"_DIGBL_I_",0))"_$$CHKTMP(.DIC,DICR,DIFILEI,I)
- I $D(DICR(DICR,"S")) S X=X_" S %Y"_DICR_"=Y,Y="_I_" X DICR("_DICR_",""S"") S Y=%Y"_DICR_" I"
- S DICR(DICR,"SUB",DIXNO+1)=X_" S DICROUT=1 Q"
- Q
- ;
- CHKTMP(DIC,DICR,DIFILEI,DIVAR) ; If DIC(0)["T", add check to make sure entry hasn't already been presented once before.
- I DIC(0)'["T"!(DICR'=1) Q ""
- Q ",'$D(^TMP($J,""DICSEEN"","_DIFILEI_","_DIVAR_"))"
- ;
- SETSCR(DICODE,DICR,DIC,D,DICALL,DID,DF,DIFILEI) ; Execute screening logic for screened pointers and var.ptrs.
- N DISAV0 S DISAV0=DIC(0) D S DIC(0)=DISAV0
- . N DISAV0 X DICODE Q
- S:DIC(0)["B" D="B"
- I $D(DIC("S")) S DICR(DICR,31)=DIC("S")
- Q:$G(D)=""
- I $P(D,U,2)="",DICALL["IX^DIC",DIC(0)["M" D SETIX(.D,.DIC,.DID,.DF,.DICR,DIFILEI) Q
- I $P(D,U,2)]"",DICALL["MIX^DIC1" D SETIX(.D,.DIC,.DID,.DF,.DICR,DIFILEI) Q
- S DICR(DICR,2.2)=D
- Q
- ;
- SETIX(D,DIC,DID,DF,DICR,DIFILEI) ; If user passes list of indexes to use on pointed-to file, set up to use them.
- I '$G(DICR) N DICR S DICR=0
- I DICR D
- . N % S %=DICR(DICR,2.1)
- . I %["L",(U_D_U)'["^B^" N D S D=I_"^B"
- . I $P(D,U,2)="" D
- . . I %["M" S DICR(DICR,2.1)=$TR(%,"M")
- . . K DICR(DICR,31.1) Q
- . I $P(D,U,2)]"" D
- . . I %'["M" S DICR(DICR,2.1)=%_"M"
- . . S DICR(DICR,31.1)=D_"^-1" Q
- . S DICR(DICR,2.2)=$P(D,U) Q
- I DIC(0)["L",(U_D_U)'["^B^" S D=D_"^B"
- I $P(D,U,2)="" D
- . I DIC(0)["M" S DIC(0)=$TR(DIC(0),"M")
- . S (D,DF)=$P(D,U) K DID Q
- I $P(D,U,2)]"" D
- . S DID=D_"^-1",DID(1)=2,(D,DF)=$P(D,U)
- . S:DIC(0)'["M" DIC(0)=DIC(0)_"M" Q
- Q
- ;
- NO S Y=-1 G R
- ;
- OKTOADD(DIFILEI,DINDEX,DIFINDER) ; Return 1 if index is OK for LAYGO.
- Q:$G(DINDEX(1,"TRANCODE"))]"" 0
- Q:$G(DIFINDER)="p" 1
- Q:DINDEX="B" 1
- Q:DINDEX("#")=1 0
- Q:$D(DICR("^",DIFILEI,.01,"B")) 0
- Q:DINDEX(1,"FILE")'=DIFILEI 0
- Q:DINDEX(1,"FIELD")'=.01 0
- Q 1
- ;
- DICM0 ;SF/XAK,TKW - LOOKUP WHEN INPUT MUST BE TRANSFORMED ;2/15/00 14:40 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**16,4,20,31**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +4 ;
- P ;Pointers, called by ^DICM1
- +1 SET D=""
- NEW DICODE,DIASKOK,DIPTRIX
- +2 SET DICR(DICR,1)=DIC
- SET DIC=U_$PIECE(DS,U,3)
- SET Y=DIC(0)
- SET DIC(0)=$TRANSLATE(Y,"L","")
- +3 SET DICR(DICR,2)=$SELECT($$OKTOADD(.DIFILEI,.DINDEX,.DIFINDER):Y,1:DIC(0))
- +4 SET DICR(DICR,2.1)=$SELECT($PIECE(DS,U,2)["'":DIC(0),1:Y)
- +5 IF '$DATA(DIVPSEL)
- NEW DIVPSEL
- SET DIVPSEL(DICR)=0
- +6 IF DIC(0)["B"
- SET DIC(0)=$TRANSLATE(DIC(0),"M","")
- SET DICR(DICR,2.1)=$TRANSLATE(DICR(DICR,2.1),"M","")
- +7 SET DIC(0)=$TRANSLATE(DIC(0),"NV","")
- +8 FOR Y="DR","S","P","W"
- IF $DATA(DIC(Y))
- MERGE DICR(DICR,Y)=DIC(Y)
- KILL DIC(Y)
- +9 SET DIPTRIX=$GET(DIC("PTRIX",DIFILEI,+DINDEX(1,"FIELD"),+$PIECE($PIECE(DS,U,2),"P",2)))
- AST ; Process screens on pointers.
- +1 IF $PIECE(DS,U,2)["*"
- IF DICR(DICR,2)["L"
- NEW DID,DF
- Begin DoDot:1
- +2 FOR DICODE=" D ^DIC"," D IX^DIC"," D MIX^DIC1"
- Begin DoDot:2
- +3 SET Y=$FIND(DS,DICODE)
- IF 'Y
- QUIT
- +4 NEW I
- SET I=$PIECE($EXTRACT(DS,1,Y-$LENGTH(DICODE)-1),U,5,99)
- +5 DO SETSCR(I,.DICR,.DIC,.D,DICODE,.DID,.DF,+$PIECE($PIECE(DS,U,2),"P",2))
- QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- P1 ; Build screen to make sure selected entry is pointed-to.
- +1 SET Y="("_DICR(DICR,1)
- IF '$DATA(DO)
- GOTO L1
- KILL DO
- IF @("$O"_Y_"0))'>0")
- GOTO L1
- +2 SET I="DIC"_DICR
- SET DICODE="X ""I 0"" N "_I
- Begin DoDot:1
- +3 IF DINDEX("#")=1
- IF $DATA(DICR(DICR,"S"))
- SET DICODE=DICODE_",%Y"_DICR
- +4 SET DICODE=DICODE_" F "_I_"=0:0 S "_I_"=$O"_Y
- SET %=""""_%_""""
- End DoDot:1
- +5 Begin DoDot:1
- +6 IF $GET(DINDEX("#"))>1
- DO BLDC(Y,%,DINDEX("#"),DIFILEI,"",.DICODE,.DICR)
- QUIT
- +7 IF @("$O"_Y_%_",0))>0")
- SET DICODE=DICODE_%_",Y,"_I_")) Q:"_I_"'>0 I $D"_Y_I_",0))"_$$CHKTMP(.DIC,DICR,DIFILEI,I)
- QUIT
- +8 IF DS["DINUM=X"
- SET DICODE="I $D"_Y_"Y,0))"_$$CHKTMP(.DIC,DICR,DIFILEI,"Y")_" S "_I_"=Y"
- QUIT
- +9 IF $PIECE(DS,U,4)="0;1"
- SET DICODE=DICODE_I_")) Q:"_I_"'>0 I $P(^("_I_",0),U)=Y"_$$CHKTMP(.DIC,DICR,DIFILEI,I)
- QUIT
- +10 SET DICODE=""
- QUIT
- End DoDot:1
- IF DICODE=""
- GOTO L1
- +11 IF DINDEX("#")=1
- IF $DATA(DICR(DICR,"S"))
- SET DICODE=DICODE_" S %Y"_DICR_"=Y,Y="_I_" X DICR("_DICR_",""S"") S Y=%Y"_DICR_" I "
- +12 SET DIC("S")=DICODE_" Q"
- +13 ; If user passed list of indexes for lookup on pointed-to file, set-up.
- +14 IF DIPTRIX]""
- SET D=DIPTRIX
- DO SETIX(.D,.DIC,.DID,.DF,.DICR,+$PIECE($PIECE(DS,U,2),"P",2))
- +15 IF $GET(D)=""
- SET D="B"
- SET Y=0
- +16 NEW DS,DINDEX,DIFILEI
- DO X^DIC
- L1 KILL DIC("S"),@("DIC"_DICR)
- +1 IF Y'>0
- IF $GET(DTOUT)!($GET(DIROUT))
- GOTO R
- +2 IF Y'>0
- IF '$DATA(DICR(DICR,8))
- Begin DoDot:1
- +3 IF $GET(DICR(DICR,31.2))
- SET DIC("S")="I Y-"_DICR(DICR,31.2)
- +4 IF '$DATA(DICR(DICR,31))
- QUIT
- +5 SET DIC("S")=$SELECT($DATA(DIC("S")):DIC("S")_" ",1:"")_DICR(DICR,31)
- QUIT
- End DoDot:1
- GOTO RETRY
- +6 IF DICR(DICR,2)["L"
- IF DICR(DICR,2)["E"
- IF @("$P("_DIC_"0),U,2)'[""O""")
- IF $PIECE(@(DICR(DICR,1)_"0)"),U,2)'["O"
- IF 'DIVPSEL(DICR)
- Begin DoDot:1
- +7 NEW I
- FOR I=(DICR-1):-1
- IF '$DATA(DIVPSEL(I))
- QUIT
- SET DIVPSEL(I)=1
- +8 SET DST=" ...OK"
- SET %=1
- DO Y^DICN
- IF '$DATA(DDS)
- WRITE !
- QUIT
- End DoDot:1
- IF %-1
- GOTO L2
- R KILL DICS,DICW,DO,DIC("W"),DIC("S")
- +1 SET DIC=DICR(DICR,1)
- SET %=DICR(DICR,2)
- SET DIC(0)=$PIECE(%,"M")_$PIECE(%,"M",2)
- +2 FOR X="DR","S","P","W"
- IF $DATA(DICR(DICR,X))
- MERGE DIC(X)=DICR(DICR,X)
- +3 IF $DATA(DIC("P"))
- IF +DIC("P")=.12
- SET DIC(0)=DIC(0)_"X"
- +4 DO DO^DIC1
- SET X=+Y
- IF X'>0
- KILL X
- QUIT
- +5 ;
- L2 IF %-2
- GOTO NO
- SET DIC("S")="I Y-"_+Y_$SELECT($DATA(DICR(DICR,31)):" "_DICR(DICR,31),1:"")
- SET X=DICR(DICR)
- IF '$DATA(DDS)
- WRITE " "_X
- IF $DATA(DDS)
- IF $GET(DDH)
- DO LIST^DDSU
- +1 ;
- KILL DST
- RETRY DO DO^DIC1
- KILL DICR(U,+DO(2))
- +1 SET D=$GET(DICR(DICR,2.2))
- IF D]""
- SET DF=D
- IF D=""
- SET D="B"
- +2 SET DIC(0)=DICR(DICR,2.1)
- IF "^"[X
- SET X=DICR(DICR)
- +3 IF $DATA(DIFILEI)
- NEW DS,DINDEX,DIFILEI
- +4 IF $DATA(DICR(DICR,31))
- IF $GET(DA(1))
- IF '$GET(DA)
- MERGE DS=DA
- NEW DA
- MERGE DA=DS
- SET DA=DA(1)
- KILL DS
- +5 IF $DATA(DICR(DICR,31.1))
- SET DID=DICR(DICR,31.1)
- SET DID(1)=2
- SET DF=D
- +6 DO X^DIC
- KILL DICR(DICR,6)
- +7 GOTO R
- +8 ;
- BLDC(DIGBL,DIXNAM,DIXNO,DIFILEI,DIPGBL,DICODE,DICR) ; Build screening logic to loop through compound index, making sure pointed-to file is pointed-to by entry in index
- +1 NEW %,I,C,X,Y,DISB
- SET Y="Y"
- +2 IF $GET(DIPGBL)]""
- SET Y="(+Y_"";"_$EXTRACT(DIPGBL,2,99)_""")"
- +3 SET %=DIGBL_DIXNAM_","_Y
- +4 SET DICODE="N DICROUT,DIC"_DICR
- Begin DoDot:1
- +5 IF $DATA(DICR(DICR,"S"))
- SET DICODE=DICODE_",%Y"_DICR
- +6 SET DICODE=DICODE_" X ""I 0"" I $D"_%_")) S DICROUT=0 X DICR("_DICR_",""SUB"",2)"
- QUIT
- End DoDot:1
- +7 FOR I=2:1:DIXNO
- SET C="N DISB"_I_" S DISB"_I_"="""" "
- Begin DoDot:1
- +8 SET C=C_"F S DISB"_I_"=$O"_%_",DISB"_I_")) Q:DISB"_I_"="""" X DICR("_DICR_",""SUB"","_(I+1)_") Q:DICROUT"
- +9 SET DICR(DICR,"SUB",I)=C
- +10 SET %=%_",DISB"_I
- QUIT
- End DoDot:1
- +11 SET I="DIC"_DICR
- +12 SET X="S "_I_"=0 F S "_I_"=$O"_%_","_I_")) Q:'"_I_" I $D"_DIGBL_I_",0))"_$$CHKTMP(.DIC,DICR,DIFILEI,I)
- +13 IF $DATA(DICR(DICR,"S"))
- SET X=X_" S %Y"_DICR_"=Y,Y="_I_" X DICR("_DICR_",""S"") S Y=%Y"_DICR_" I"
- +14 SET DICR(DICR,"SUB",DIXNO+1)=X_" S DICROUT=1 Q"
- +15 QUIT
- +16 ;
- CHKTMP(DIC,DICR,DIFILEI,DIVAR) ; If DIC(0)["T", add check to make sure entry hasn't already been presented once before.
- +1 IF DIC(0)'["T"!(DICR'=1)
- QUIT ""
- +2 QUIT ",'$D(^TMP($J,""DICSEEN"","_DIFILEI_","_DIVAR_"))"
- +3 ;
- SETSCR(DICODE,DICR,DIC,D,DICALL,DID,DF,DIFILEI) ; Execute screening logic for screened pointers and var.ptrs.
- +1 NEW DISAV0
- SET DISAV0=DIC(0)
- Begin DoDot:1
- +2 NEW DISAV0
- XECUTE DICODE
- QUIT
- End DoDot:1
- SET DIC(0)=DISAV0
- +3 IF DIC(0)["B"
- SET D="B"
- +4 IF $DATA(DIC("S"))
- SET DICR(DICR,31)=DIC("S")
- +5 IF $GET(D)=""
- QUIT
- +6 IF $PIECE(D,U,2)=""
- IF DICALL["IX^DIC"
- IF DIC(0)["M"
- DO SETIX(.D,.DIC,.DID,.DF,.DICR,DIFILEI)
- QUIT
- +7 IF $PIECE(D,U,2)]""
- IF DICALL["MIX^DIC1"
- DO SETIX(.D,.DIC,.DID,.DF,.DICR,DIFILEI)
- QUIT
- +8 SET DICR(DICR,2.2)=D
- +9 QUIT
- +10 ;
- SETIX(D,DIC,DID,DF,DICR,DIFILEI) ; If user passes list of indexes to use on pointed-to file, set up to use them.
- +1 IF '$GET(DICR)
- NEW DICR
- SET DICR=0
- +2 IF DICR
- Begin DoDot:1
- +3 NEW %
- SET %=DICR(DICR,2.1)
- +4 IF %["L"
- IF (U_D_U)'["^B^"
- NEW D
- SET D=I_"^B"
- +5 IF $PIECE(D,U,2)=""
- Begin DoDot:2
- +6 IF %["M"
- SET DICR(DICR,2.1)=$TRANSLATE(%,"M")
- +7 KILL DICR(DICR,31.1)
- QUIT
- End DoDot:2
- +8 IF $PIECE(D,U,2)]""
- Begin DoDot:2
- +9 IF %'["M"
- SET DICR(DICR,2.1)=%_"M"
- +10 SET DICR(DICR,31.1)=D_"^-1"
- QUIT
- End DoDot:2
- +11 SET DICR(DICR,2.2)=$PIECE(D,U)
- QUIT
- End DoDot:1
- +12 IF DIC(0)["L"
- IF (U_D_U)'["^B^"
- SET D=D_"^B"
- +13 IF $PIECE(D,U,2)=""
- Begin DoDot:1
- +14 IF DIC(0)["M"
- SET DIC(0)=$TRANSLATE(DIC(0),"M")
- +15 SET (D,DF)=$PIECE(D,U)
- KILL DID
- QUIT
- End DoDot:1
- +16 IF $PIECE(D,U,2)]""
- Begin DoDot:1
- +17 SET DID=D_"^-1"
- SET DID(1)=2
- SET (D,DF)=$PIECE(D,U)
- +18 IF DIC(0)'["M"
- SET DIC(0)=DIC(0)_"M"
- QUIT
- End DoDot:1
- +19 QUIT
- +20 ;
- NO SET Y=-1
- GOTO R
- +1 ;
- OKTOADD(DIFILEI,DINDEX,DIFINDER) ; Return 1 if index is OK for LAYGO.
- +1 IF $GET(DINDEX(1,"TRANCODE"))]""
- QUIT 0
- +2 IF $GET(DIFINDER)="p"
- QUIT 1
- +3 IF DINDEX="B"
- QUIT 1
- +4 IF DINDEX("#")=1
- QUIT 0
- +5 IF $DATA(DICR("^",DIFILEI,.01,"B"))
- QUIT 0
- +6 IF DINDEX(1,"FILE")'=DIFILEI
- QUIT 0
- +7 IF DINDEX(1,"FIELD")'=.01
- QUIT 0
- +8 QUIT 1
- +9 ;
