- DIEZ0 ;SFISC/GFT-COMPILE INPUT TEMPLATE ;13SEP2004
- ;;22.0;VA FileMan;**159**;Mar 30, 1999;Build 8
- ;Per VHA Directive 2004-038, this routine should not be modified.
- D L
- DL S DQ=0,DK=0,DQFF=0
- MR S DK=DK+1,DH=$P(DR,";",DK),DI=$P(DH,":",1),(DIEZP,DIEZDUP,DIEZR)="" G:'DI K:DI=0,PB S DPR=$P(DH,"//",2,99),DM=+DI S:DPR]"" DI=$P(DI,"//",1),DH=""
- G K:DM=DI S Y=$P(DI,DM,2,99) G MR:Y=""!'$D(^DD(DP,DM,0)) F %=1:1 S X=$P(Y,$C(126),%) Q:X="" S:X="d" DIEZDUP=X S:X="R" DIEZR=X S:X'="d"&(X'="R")&(X'="T") DIEZP=X D:X="T"
- .I $D(^DD(DP,DM,.1)) S DIEZP=^(.1) Q
- .I +$P(^DD(DP,DM,0),U,2),$P(^DD(+$P(^(0),U,2),.01,0),U,2)["W",$D(^(.1)) S DIEZP=^(.1)
- .Q
- S (DI,DM)=+DI G S
- K S DM=$P(DH,":",2),DM=$S(DM:DM,1:+DI) I DI,$D(^DD(DP,+DI)) G S
- NX ;
- S DI=$O(^DD(DP,+DI)),DIEZP="" S:DI="" DI=-1 G MR:DI'>0,MR:DI>DM
- S S Y=^DD(DP,+DI,0),DV=$P(Y,U,2)_$E("#",Y["DINUM")_DIEZR_DIEZDUP S:DIEZP=""&'DV DIEZP=$P(Y,U,1)
- S X=DIEZP,DW=$P(Y,U,4) G NX:$A(DW)=32 I T>DMAX D SV G:DIEZQ K^DIEZ2 G S
- W:'$G(DIEZS) "." S DQ=DQ+1,DI=+DI,DU=$P(Y,U,3),%=" S "
- K DIEZOT I DV["O",$D(^(2)) D O^DIEZ2
- I DQFF S %=" D:$D(DG)>9 F^DIE17,DE S DQ="_DQ_",",DQFF=0
- I DV S Y=X,X=DQ_%_"D=0 K DE(1) ;"_DI D L,DRN G MUL^DIEZ2
- S ^UTILITY($J,U,$P(DW,";",1),$P(DW,";",2),DQ)="",T=T+35,X=DQ_%_"DW="""_DW_""",DV="""_DV_""",DU="""",DLB="""_X_""",DIFLD="_DI D L
- I $D(DIEZOT) S X=DIEZOT D L K DIEZOT
- S DIEZXREF=$O(^DD("IX","F",DP,DI,0))
- I $O(^DD(DP,DI,1,0))>0!(DV["a")!DIEZXREF D
- . S DQFF=1,X=" S DE(DW)=""C"_DQ_U_DNM_DRN_""""
- . S:DIEZXREF X=X_",DE(DW,""INDEX"")=1"
- . ;Determine whether this field is part of a field-level key.
- . ;Also, build list: DIEZKEY(uniquenessIndex)=""
- . ;for those indexes that are uniqueness indexes for keys.
- . N DIEZK,DIEZUI
- . K DIEZKEY S DIEZK=0
- . F S DIEZK=$O(^DD("KEY","F",DP,DI,DIEZK)) Q:'DIEZK D
- .. S DIEZUI=$P($G(^DD("KEY",DIEZK,0)),U,4) Q:'DIEZUI
- .. S:$P($G(^DD("IX",DIEZUI,0)),U,6)="F" DIEZKEY(DIEZUI)=""
- . S:$D(DIEZKEY) X=X_",DE(DW,""KEY"")=""$$K"_DQ_""""
- . D L
- K DIEZXREF
- X D PR,XREF^DIEZ2:DQFF S %=$P(Y,U,5,99),X=$F(%,"%DT=""") I X,DPR?1"/".E S Y=$F(%,"E",X) I Y S %=$E(%,1,Y-2)_$E(%,Y,999)
- I DPR?1"//".E S %=""
- D AF^DIEZ2 S X="X"_DQ_" " I "Q"[% S X=X_"Q" D L G NX
- S X=X_% D L I DV["F" S X=" I $D(X),X'?.ANP K X" D L
- S X=" Q" D L S X=" ;" D L G NX
- ;
- PB I DH="" S:'$D(DOV(DL)) DOV(DL)=0 S DOV(DL)=$O(^DIE(DIEZ,"DR",DIER,DP,DOV(DL))) S:DOV(DL)="" DOV(DL)=-1 G UP:DOV(DL)<0 S DR=^(DOV(DL)),DK=0 G MR
- S DQ=DQ+1 I DH?1"@".N S X=DQ_" S DQ="_(DQ+1)_" ;"_DH,^UTILITY($J,"AB",DIEZAB,DH)=DQ_U_DNM_DRN G M
- S X=DQ_" D:$D(DG)>9 F^DIE17,DE S Y=U,DQ="_DQ_" " I "Q"[DH S X=X_"G A" G M
- I DH?1"^".E S F=0,X=X_$P(DH,U,5,999),Q=$P(DH,U,1,3) D L,DRN,QFF^DIEZ2,DIERN^DIEZ2 S X=" S DGO=""^"_DNM_%_""",DC="_Q_" G DIEZ^DIE0",DRN(%)=$P(DH,U,2)_U_DIERN_U_$P(DH,U,3)_U_U_DQ_U_DRN D L S X="R"_DQ_" D DE G A" D L S X=" ;" G M
- S X=X_"D X"_DQ_" D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)=""F"",DW=DQ G OUT^DIE17" D L S X="X"_DQ_" "_DH D L S X=" Q"
- M D L G MR
- ;
- UP S DQ=DQ+1,X=DQ_" G "_(DL>1)_"^DIE17" D L,^DIEZ1 G:DIEZQ K^DIEZ2 S Y=0
- LV S Y=$O(DRN(Y)) S:Y="" Y=-1 I Y<0 G ^DIEZ2
- S X=DRN(Y) G LV:X=U S DRN=Y,DP=+X,DIER=$P(X,U,2),DL=DIER\1,DIE=U_$P(X,U,3),DIEZL=+$P(X,U,4),DIEZAB=$P(X,U,5)_U_DNM_$P(X,U,6),DR=$S($D(^DIE(DIEZ,"DR",DIER,DP)):^(DP),1:"0:9999999"),DRN(Y)=U D N S:+DR=.01!(DR?1"0:".E) ^(3)=^(3)_"+D G B" G DL
- ;
- PR ;
- D DU^DIEZ2:DU]"" S X=" G RE" I DW="0;1",DL>1,DQ=1 S X=X_":'D S DQ=2 G 2"
- D PR^DIEZ2:DPR]""
- L S L=L+1,^UTILITY($J,0,L)=X,T=T+$L(X)+2 S:X?1N.E T=T+15 Q
- ;
- SV D DRN
- S X=DQ+1_" D:$D(DG)>9 F^DIE17 G ^"_DNM_%,DQ=% D L,^DIEZ1 Q:DIEZQ
- N G NEWROU^DIEZ
- ;
- DRN F %=DRN+1:1 Q:'$D(DRN(%))
- DIEZ0 ;SFISC/GFT-COMPILE INPUT TEMPLATE ;13SEP2004
- +1 ;;22.0;VA FileMan;**159**;Mar 30, 1999;Build 8
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 DO L
- DL SET DQ=0
- SET DK=0
- SET DQFF=0
- MR SET DK=DK+1
- SET DH=$PIECE(DR,";",DK)
- SET DI=$PIECE(DH,":",1)
- SET (DIEZP,DIEZDUP,DIEZR)=""
- IF 'DI
- IF DI=0
- GOTO K
- GOTO PB
- SET DPR=$PIECE(DH,"//",2,99)
- SET DM=+DI
- IF DPR]""
- SET DI=$PIECE(DI,"//",1)
- SET DH=""
- +1 IF DM=DI
- GOTO K
- SET Y=$PIECE(DI,DM,2,99)
- IF Y=""!'$DATA(^DD(DP,DM,0))
- GOTO MR
- FOR %=1:1
- SET X=$PIECE(Y,$CHAR(126),%)
- IF X=""
- QUIT
- IF X="d"
- SET DIEZDUP=X
- IF X="R"
- SET DIEZR=X
- IF X'="d"&(X'="R")&(X'="T")
- SET DIEZP=X
- IF X="T"
- Begin DoDot:1
- +2 IF $DATA(^DD(DP,DM,.1))
- SET DIEZP=^(.1)
- QUIT
- +3 IF +$PIECE(^DD(DP,DM,0),U,2)
- IF $PIECE(^DD(+$PIECE(^(0),U,2),.01,0),U,2)["W"
- IF $DATA(^(.1))
- SET DIEZP=^(.1)
- +4 QUIT
- End DoDot:1
- +5 SET (DI,DM)=+DI
- GOTO S
- K SET DM=$PIECE(DH,":",2)
- SET DM=$SELECT(DM:DM,1:+DI)
- IF DI
- IF $DATA(^DD(DP,+DI))
- GOTO S
- NX ;
- +1 SET DI=$ORDER(^DD(DP,+DI))
- SET DIEZP=""
- IF DI=""
- SET DI=-1
- IF DI'>0
- GOTO MR
- IF DI>DM
- GOTO MR
- S SET Y=^DD(DP,+DI,0)
- SET DV=$PIECE(Y,U,2)_$EXTRACT("#",Y["DINUM")_DIEZR_DIEZDUP
- IF DIEZP=""&'DV
- SET DIEZP=$PIECE(Y,U,1)
- +1 SET X=DIEZP
- SET DW=$PIECE(Y,U,4)
- IF $ASCII(DW)=32
- GOTO NX
- IF T>DMAX
- DO SV
- IF DIEZQ
- GOTO K^DIEZ2
- GOTO S
- +2 IF '$GET(DIEZS)
- WRITE "."
- SET DQ=DQ+1
- SET DI=+DI
- SET DU=$PIECE(Y,U,3)
- SET %=" S "
- +3 KILL DIEZOT
- IF DV["O"
- IF $DATA(^(2))
- DO O^DIEZ2
- +4 IF DQFF
- SET %=" D:$D(DG)>9 F^DIE17,DE S DQ="_DQ_","
- SET DQFF=0
- +5 IF DV
- SET Y=X
- SET X=DQ_%_"D=0 K DE(1) ;"_DI
- DO L
- DO DRN
- GOTO MUL^DIEZ2
- +6 SET ^UTILITY($JOB,U,$PIECE(DW,";",1),$PIECE(DW,";",2),DQ)=""
- SET T=T+35
- SET X=DQ_%_"DW="""_DW_""",DV="""_DV_""",DU="""",DLB="""_X_""",DIFLD="_DI
- DO L
- +7 IF $DATA(DIEZOT)
- SET X=DIEZOT
- DO L
- KILL DIEZOT
- +8 SET DIEZXREF=$ORDER(^DD("IX","F",DP,DI,0))
- +9 IF $ORDER(^DD(DP,DI,1,0))>0!(DV["a")!DIEZXREF
- Begin DoDot:1
- +10 SET DQFF=1
- SET X=" S DE(DW)=""C"_DQ_U_DNM_DRN_""""
- +11 IF DIEZXREF
- SET X=X_",DE(DW,""INDEX"")=1"
- +12 ;Determine whether this field is part of a field-level key.
- +13 ;Also, build list: DIEZKEY(uniquenessIndex)=""
- +14 ;for those indexes that are uniqueness indexes for keys.
- +15 NEW DIEZK,DIEZUI
- +16 KILL DIEZKEY
- SET DIEZK=0
- +17 FOR
- SET DIEZK=$ORDER(^DD("KEY","F",DP,DI,DIEZK))
- IF 'DIEZK
- QUIT
- Begin DoDot:2
- +18 SET DIEZUI=$PIECE($GET(^DD("KEY",DIEZK,0)),U,4)
- IF 'DIEZUI
- QUIT
- +19 IF $PIECE($GET(^DD("IX",DIEZUI,0)),U,6)="F"
- SET DIEZKEY(DIEZUI)=""
- End DoDot:2
- +20 IF $DATA(DIEZKEY)
- SET X=X_",DE(DW,""KEY"")=""$$K"_DQ_""""
- +21 DO L
- End DoDot:1
- +22 KILL DIEZXREF
- X DO PR
- IF DQFF
- DO XREF^DIEZ2
- SET %=$PIECE(Y,U,5,99)
- SET X=$FIND(%,"%DT=""")
- IF X
- IF DPR?1"/".E
- SET Y=$FIND(%,"E",X)
- IF Y
- SET %=$EXTRACT(%,1,Y-2)_$EXTRACT(%,Y,999)
- +1 IF DPR?1"//".E
- SET %=""
- +2 DO AF^DIEZ2
- SET X="X"_DQ_" "
- IF "Q"[%
- SET X=X_"Q"
- DO L
- GOTO NX
- +3 SET X=X_%
- DO L
- IF DV["F"
- SET X=" I $D(X),X'?.ANP K X"
- DO L
- +4 SET X=" Q"
- DO L
- SET X=" ;"
- DO L
- GOTO NX
- +5 ;
- PB IF DH=""
- IF '$DATA(DOV(DL))
- SET DOV(DL)=0
- SET DOV(DL)=$ORDER(^DIE(DIEZ,"DR",DIER,DP,DOV(DL)))
- IF DOV(DL)=""
- SET DOV(DL)=-1
- IF DOV(DL)<0
- GOTO UP
- SET DR=^(DOV(DL))
- SET DK=0
- GOTO MR
- +1 SET DQ=DQ+1
- IF DH?1"@".N
- SET X=DQ_" S DQ="_(DQ+1)_" ;"_DH
- SET ^UTILITY($JOB,"AB",DIEZAB,DH)=DQ_U_DNM_DRN
- GOTO M
- +2 SET X=DQ_" D:$D(DG)>9 F^DIE17,DE S Y=U,DQ="_DQ_" "
- IF "Q"[DH
- SET X=X_"G A"
- GOTO M
- +3 IF DH?1"^".E
- SET F=0
- SET X=X_$PIECE(DH,U,5,999)
- SET Q=$PIECE(DH,U,1,3)
- DO L
- DO DRN
- DO QFF^DIEZ2
- DO DIERN^DIEZ2
- SET X=" S DGO=""^"_DNM_%_""",DC="_Q_" G DIEZ^DIE0"
- SET DRN(%)=$PIECE(DH,U,2)_U_DIERN_U_$PIECE(DH,U,3)_U_U_DQ_U_DRN
- DO L
- SET X="R"_DQ_" D DE G A"
- DO L
- SET X=" ;"
- GOTO M
- +4 SET X=X_"D X"_DQ_" D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)=""F"",DW=DQ G OUT^DIE17"
- DO L
- SET X="X"_DQ_" "_DH
- DO L
- SET X=" Q"
- M DO L
- GOTO MR
- +1 ;
- UP SET DQ=DQ+1
- SET X=DQ_" G "_(DL>1)_"^DIE17"
- DO L
- DO ^DIEZ1
- IF DIEZQ
- GOTO K^DIEZ2
- SET Y=0
- LV SET Y=$ORDER(DRN(Y))
- IF Y=""
- SET Y=-1
- IF Y<0
- GOTO ^DIEZ2
- +1 SET X=DRN(Y)
- IF X=U
- GOTO LV
- SET DRN=Y
- SET DP=+X
- SET DIER=$PIECE(X,U,2)
- SET DL=DIER\1
- SET DIE=U_$PIECE(X,U,3)
- SET DIEZL=+$PIECE(X,U,4)
- SET DIEZAB=$PIECE(X,U,5)_U_DNM_$PIECE(X,U,6)
- SET DR=$SELECT($DATA(^DIE(DIEZ,"DR",DIER,DP)):^(DP),1:"0:9999999")
- SET DRN(Y)=U
- DO N
- IF +DR=.01!(DR?1"0
- SET ^(3)=^(3)_"+D G B"
- GOTO DL
- +2 ;
- PR ;
- +1 IF DU]""
- DO DU^DIEZ2
- SET X=" G RE"
- IF DW="0;1"
- IF DL>1
- IF DQ=1
- SET X=X_":'D S DQ=2 G 2"
- +2 IF DPR]""
- DO PR^DIEZ2
- L SET L=L+1
- SET ^UTILITY($JOB,0,L)=X
- SET T=T+$LENGTH(X)+2
- IF X?1N.E
- SET T=T+15
- QUIT
- +1 ;
- SV DO DRN
- +1 SET X=DQ+1_" D:$D(DG)>9 F^DIE17 G ^"_DNM_%
- SET DQ=%
- DO L
- DO ^DIEZ1
- IF DIEZQ
- QUIT
- N GOTO NEWROU^DIEZ
- +1 ;
- DRN FOR %=DRN+1:1
- IF '$DATA(DRN(%))
- QUIT
