INHSGZ22 ;JSH; 16 Nov 95 17:05;Script generator - audit code
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
INIT ;Start to build audit routine
D K S ARMAX=$G(^DD("ROU")) S:'ARMAX ARMAX=4000 S ARNAME="IV"_$E(SCR#100000+100000,2,6),(ARDC,ARNUM)=0
D NEWROU Q
;
K ;Kill vars
K ^UTILITY("INAUD",$J),ARNOBRK,ARNAME,ARMAX,ARDC,ARNUM,ARDL,ARSEG,ADL,AMULT Q
;
NEWROU ;Make new routine
S ARNUM=ARNUM+1 K ^UTILITY("INAUD",$J,ARNUM) S ARLINE=0,Y=$$DT^UTDT X ^DD("DD")
S ^UTILITY("INAUD",$J,ARNUM,1)=ARNAME_$S(ARNUM>1:$C(63+ARNUM),1:"")_" ;Audit routine for message '"_$P(MESS(0),U)_"' compiled "_Y
S ^UTILITY("INAUD",$J,ARNUM,2)=" ;Part "_ARNUM
S:ARNUM=1 ^UTILITY("INAUD",$J,1,2.5)="INIT S INAUDWP=0 K ^INVQA(UIF,1) Q",^(2.6)="FINISH S ^INVQA(UIF,1,0)=""^^""_+$G(INAUDWP)_""^""_+$G(INAUDWP) K ^UTILITY(""INVAUD"",$J) Q"
S ^(3)="L(%X) ;Place line in WP field",^(4)=" S INAUDWP=INAUDWP+1,^INVQA(UIF,1,INAUDWP,0)=%X_""|CR|"" Q"
S ^(5)="EN ;",ARLINE=5,ARSIZE=250 Q
;
L(%X) ;Add line to routine
I '$D(ARNOBRK) D:ARSIZE+$L(%X)>ARMAX
. S ^UTILITY("INAUD",$J,ARNUM,ARLINE+1)=" G EN^"_ARNAME_$C(64+ARNUM) D NEWROU
S ARLINE=ARLINE+1,^UTILITY("INAUD",$J,ARNUM,ARLINE)=%X,ARSIZE=ARSIZE+$L(%X) K ANOBRK Q
;
FILE ;File at end
G:'$D(^UTILITY("INAUD",$J)) K
W ! N INI,X S INI=0 F S INI=$O(^UTILITY("INAUD",$J,INI)) Q:'INI D
.K ^UTILITY($J,0) M ^UTILITY($J,0)=^UTILITY("INAUD",$J,INI)
.S X=$P(^UTILITY($J,0,1)," ") X ^DD("OS",^DD("OS"),"ZS") W !,"Audit routine: "_X_" ...filed"
G K
;
SEGINIT ;Start a new segment
D L($P(SEG(0),U,2)_" ;"_$P(SEG(0),U)) S ARSEG($P(SEG(0),U,2))=ARNUM
D L(" Q:'$G(INAUDIT) N ZDIE,X,Y,Z S ZDIE=$E(DIE(1),1,$L(DIE(1))-1) S:ZDIE[""("" ZDIE=ZDIE_"")"" S D0=INDA")
D:REPEAT
. D L(" D L("""_$P(SEG(0),U,2)_" - "_$P(SEG(0),U)_" Iteration #""_INI)")
. D L(" D L(""File: "_$O(^DD(+FILE(FLVL),0,"NM",""))_$S($D(^DD(+FILE(FLVL),0,"UP")):" SUB-FIELD",1:"")_" IEN: ""_INDA),L("""")")
D:'REPEAT
. D L(" D L("""_$P(SEG(0),U,2)_" - "_$P(SEG(0),U)_""")")
. D L(" D L(""File: "_$O(^DD(+FILE(FLVL),0,"NM",""))_" IEN: ""_INDA),L("""")")
Q
;
SEGEND ;End a segment
D L(" D L("""") Q") Q
;
FIELD(%F) ;Process a field
;%F = dictionary number
N I,J,DICOMP,DICOMPX,DA,DQI,DICMX,X,Z,N,C,A,B
S I(0)="@ZDIE@(",J(0)=%F,DA="DXS(",DQI="Y(",X=DL,DICOMPX="" S:+X=X X="#"_X D ^DICOMP
Q:'$D(X) I Y["D" S X=X_" S Y=X D DD^%DT S X=Y"
I $D(X)>9 S I=0 F S I=$O(X(I)) Q:'I D L(" S DXS("_I_")="""_$$REPLACE^UTIL(X(I),"""","""""")_"""")
S Z=$P(DICOMPX,";"),N=$J(INF,2),I=$E($P(^DD(+Z,$P(Z,U,2),0),U),1,16),I=I_$J("",16-$L(I)),C=$P(^DD(+Z,$P(Z,U,2),0),U,2)["C"
I C,SLVL S A="S " D D L(" "_A_"D"_SLVL_"=INDA") S X=X_" S D0=INDA"
. F B=1:1:SLVL S A=A_"D"_(SLVL-B)_"=INDA("_B_"),"
D L(" "_X_" K DXS")
D L(" S Y=^UTILITY(""INVAUD"",$J,"_$$VEXP(SVAR)_",D="" """)
I $P(DTY(0),U,2)="DT"!($P(DTY(0),U,2)="TS")!($P(DTY(0),U,2)="CP") D L(" S Z=X,X=Y "_^INTHL7FT(DTY,2)),L(" S Y=X,X=Z")
I $P(DTY(0),U,2)="CN"!($P(DTY(0),U,2)="ID"),MAP D L(" S Y=$$MAP^INHVA2("_MAP_",Y,0),Y=$P(Y,U,2)")
I $P(DTY(0),U,2)="CN"!($P(DTY(0),U,2)="CP") D L(" S:$L(Y)&(Y[SUBDELIM) Y=$P(Y,SUBDELIM,2,99)")
D L(" I X'=Y S:'(Y=""""&(X=0)) D=""*""")
D L(" S Y=Y_$J("""",50-$L(Y)),X=X_$J("""",50-$L(X)) D L(D_"""_N_". "_I_" ""_Y_"" ""_X)")
Q
;
VEXP(V) ;Expand variable
N X,I
S X=""""_V_""""
F I=1:1:SLVL S X=X_",INI"_$S(I'=SLVL:"("_I_")",1:"")
Q X_")"
INHSGZ22 ;JSH; 16 Nov 95 17:05;Script generator - audit code
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
INIT ;Start to build audit routine
+1 DO K
SET ARMAX=$GET(^DD("ROU"))
IF 'ARMAX
SET ARMAX=4000
SET ARNAME="IV"_$EXTRACT(SCR#100000+100000,2,6)
SET (ARDC,ARNUM)=0
+2 DO NEWROU
QUIT
+3 ;
K ;Kill vars
+1 KILL ^UTILITY("INAUD",$JOB),ARNOBRK,ARNAME,ARMAX,ARDC,ARNUM,ARDL,ARSEG,ADL,AMULT
QUIT
+2 ;
NEWROU ;Make new routine
+1 SET ARNUM=ARNUM+1
KILL ^UTILITY("INAUD",$JOB,ARNUM)
SET ARLINE=0
SET Y=$$DT^UTDT
XECUTE ^DD("DD")
+2 SET ^UTILITY("INAUD",$JOB,ARNUM,1)=ARNAME_$SELECT(ARNUM>1:$CHAR(63+ARNUM),1:"")_" ;Audit routine for message '"_$PIECE(MESS(0),U)_"' compiled "_Y
+3 SET ^UTILITY("INAUD",$JOB,ARNUM,2)=" ;Part "_ARNUM
+4 IF ARNUM=1
SET ^UTILITY("INAUD",$JOB,1,2.5)="INIT S INAUDWP=0 K ^INVQA(UIF,1) Q"
SET ^(2.6)="FINISH S ^INVQA(UIF,1,0)=""^^""_+$G(INAUDWP)_""^""_+$G(INAUDWP) K ^UTILITY(""INVAUD"",$J) Q"
+5 SET ^(3)="L(%X) ;Place line in WP field"
SET ^(4)=" S INAUDWP=INAUDWP+1,^INVQA(UIF,1,INAUDWP,0)=%X_""|CR|"" Q"
+6 SET ^(5)="EN ;"
SET ARLINE=5
SET ARSIZE=250
QUIT
+7 ;
L(%X) ;Add line to routine
+1 IF '$DATA(ARNOBRK)
IF ARSIZE+$LENGTH(%X)>ARMAX
Begin DoDot:1
+2 SET ^UTILITY("INAUD",$JOB,ARNUM,ARLINE+1)=" G EN^"_ARNAME_$CHAR(64+ARNUM)
DO NEWROU
End DoDot:1
+3 SET ARLINE=ARLINE+1
SET ^UTILITY("INAUD",$JOB,ARNUM,ARLINE)=%X
SET ARSIZE=ARSIZE+$LENGTH(%X)
KILL ANOBRK
QUIT
+4 ;
FILE ;File at end
+1 IF '$DATA(^UTILITY("INAUD",$JOB))
GOTO K
+2 WRITE !
NEW INI,X
SET INI=0
FOR
SET INI=$ORDER(^UTILITY("INAUD",$JOB,INI))
IF 'INI
QUIT
Begin DoDot:1
+3 KILL ^UTILITY($JOB,0)
MERGE ^UTILITY($JOB,0)=^UTILITY("INAUD",$JOB,INI)
+4 SET X=$PIECE(^UTILITY($JOB,0,1)," ")
XECUTE ^DD("OS",^DD("OS"),"ZS")
WRITE !,"Audit routine: "_X_" ...filed"
End DoDot:1
+5 GOTO K
+6 ;
SEGINIT ;Start a new segment
+1 DO L($PIECE(SEG(0),U,2)_" ;"_$PIECE(SEG(0),U))
SET ARSEG($PIECE(SEG(0),U,2))=ARNUM
+2 DO L">L(" Q:'$G(INAUDIT) N ZDIE,X,Y,Z S ZDIE=$E(DIE(1),1,$L">L(DIE(1))-1) S:ZDIE[""("" ZDIE=ZDIE_"")"" S D0=INDA")
+3 IF REPEAT
Begin DoDot:1
+4 DO L(" D L("""_$PIECE(SEG(0),U,2)_" - "_$PIECE(SEG(0),U)_" Iteration #""_INI)")
+5 DO L(" D L(""File: "_$ORDER(^DD(+FILE(FLVL),0,"NM",""))_$SELECT($DATA(^DD(+FILE(FLVL),0,"UP")):" SUB-FIELD",1:"")_" IEN: ""_INDA),L("""")")
End DoDot:1
+6 IF 'REPEAT
Begin DoDot:1
+7 DO L(" D L("""_$PIECE(SEG(0),U,2)_" - "_$PIECE(SEG(0),U)_""")")
+8 DO L(" D L(""File: "_$ORDER(^DD(+FILE(FLVL),0,"NM",""))_" IEN: ""_INDA),L("""")")
End DoDot:1
+9 QUIT
+10 ;
SEGEND ;End a segment
+1 DO L(" D L("""") Q")
QUIT
+2 ;
FIELD(%F) ;Process a field
+1 ;%F = dictionary number
+2 NEW I,J,DICOMP,DICOMPX,DA,DQI,DICMX,X,Z,N,C,A,B
+3 SET I(0)="@ZDIE@("
SET J(0)=%F
SET DA="DXS("
SET DQI="Y("
SET X=DL
SET DICOMPX=""
IF +X=X
SET X="#"_X
DO ^DICOMP
+4 IF '$DATA(X)
QUIT
IF Y["D"
SET X=X_" S Y=X D DD^%DT S X=Y"
+5 IF $DATA(X)>9
SET I=0
FOR
SET I=$ORDER(X(I))
IF 'I
QUIT
DO L(" S DXS("_I_")="""_$$REPLACE^UTIL(X(I),"""","""""")_"""")
+6 SET Z=$PIECE(DICOMPX,";")
SET N=$JUSTIFY(INF,2)
SET I=$EXTRACT($PIECE(^DD(+Z,$PIECE(Z,U,2),0),U),1,16)
SET I=I_$JUSTIFY("",16-$LENGTH(I))
SET C=$PIECE(^DD(+Z,$PIECE(Z,U,2),0),U,2)["C"
+7 IF C
IF SLVL
SET A="S "
Begin DoDot:1
+8 FOR B=1:1:SLVL
SET A=A_"D"_(SLVL-B)_"=INDA("_B_"),"
End DoDot:1
DO L(" "_A_"D"_SLVL_"=INDA")
SET X=X_" S D0=INDA"
+9 DO L(" "_X_" K DXS")
+10 DO L(" S Y=^UTILITY(""INVAUD"",$J,"_$$VEXP(SVAR)_",D="" """)
+11 IF $PIECE(DTY(0),U,2)="DT"!($PIECE(DTY(0),U,2)="TS")!($PIECE(DTY(0),U,2)="CP")
DO L(" S Z=X,X=Y "_^INTHL7FT(DTY,2))
DO L(" S Y=X,X=Z")
+12 IF $PIECE(DTY(0),U,2)="CN"!($PIECE(DTY(0),U,2)="ID")
IF MAP
DO L(" S Y=$$MAP^INHVA2("_MAP_",Y,0),Y=$P(Y,U,2)")
+13 IF $PIECE(DTY(0),U,2)="CN"!($PIECE(DTY(0),U,2)="CP")
DO L">L(" S:$L">L(Y)&(Y[SUBDEL">LIM) Y=$P(Y,SUBDEL">LIM,2,99)")
+14 DO L(" I X'=Y S:'(Y=""""&(X=0)) D=""*""")
+15 DO L">L">L">L(" S Y=Y_$J("""",50-$L">L">L">L(Y)),X=X_$J("""",50-$L">L">L">L(X)) D L">L">L">L(D_"""_N_". "_I_" ""_Y_"" ""_X)")
+16 QUIT
+17 ;
VEXP(V) ;Expand variable
+1 NEW X,I
+2 SET X=""""_V_""""
+3 FOR I=1:1:SLVL
SET X=X_",INI"_$SELECT(I'=SLVL:"("_I_")",1:"")
+4 QUIT X_")"
