INHSGZ21 ;JSH; 1 Jul 97 10:20;Continuation of INHSGZ2
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
L(%L,%C) ;Place a line in the global
G L1^INHSGZ2
;
PROC ;Check if field is to be used in lookup
;Also look for the .01 field
;Create template code for it
N ML,DL,DA,Y,DQI,X,DICOMPX,I,F,I0
S DL=$G(^INTHL7F(FIELD,"C")) Q:DL="" ;I DL="" D WARN^INHSGZ2("Field '"_$P(FIELD(0),U)_"' is missing a data location - IGNORED.") Q
S ML=$P(^INTHL7F(FIELD,0),U,3)
DIC K DIC S X=DL,DIC="^DD("_+FILE(FLVL)_",",DIC(0)="FZ",DIC("S")="I $P(^(0),U,2)'[""C""" D ^DIC I Y>0 S DICOMPX=+FILE(FLVL)_U_+Y,%=1 D G FOK:% Q
. Q:'$P(^DD(+FILE(FLVL),+Y,0),U,2)
. S MULT=+$P(^(0),U,2) I $P(^DD(MULT,.01,0),U,2)["W" D S (MULT,%)=0 Q
.. N N S N=$P($P(^DD(+FILE(FLVL),+Y,0),U,4),";") I $P(FIELD(0),U,4) D Q
... S A="I $G(DIPA("""_SVAR_"""))]"""" N I,% S %=0,INDIG=DIE_DA_"","""""_N_""""")"" F I=0:0 S:'$O(@INDIG@(I)) ^(I+1,0)=DIPA("""_SVAR_"""),%=1,@INDIG@(0)=U_U_(I+1)_U_(I+1)_U_DT S I=$O(@INDIG@(I)) Q:%" D TL
.. S A="I $G(DIPA("""_SVAR_"""))]"""" S INDIG=DIE_DA_"","""""_N_""""")"" K @INDIG S @INDIG@(1,0)=DIPA("""_SVAR_"""),@INDIG@(0)=U_U_1_U_1_U_DT" D TL
S J(0)=+FILE(FLVL),I(0)="" I '$D(^DD(J(0))) D ERROR^INHSGZ2("File #"_+FILE_" does not exist.") Q
S DA="DA(",DQI="Y(",DICOMPX="",X=DL S:X X="#"_X
I $E(X)'="@" D ^DICOMP I '$D(X),'MULT D ERROR^INHSGZ2("DATA LOCATION for field '"_$P(FIELD(0),U)_"' is invalid.") Q
I MULT S FLVL=FLVL-1,MULT=0,A="||" D TL S MULTL(0)=1 G DIC
FOK I $G(MULTL(0)) S $P(MULTL(MULTL),U,3)=+$P(DICOMPX,U,2),MULTL=MULTL-1 K MULTL(0)
D:OTHER
. I $L(DICOMPX,";")=1,DICOMPX[(+FILE(FLVL)_U_".01") D Q
.. S A="" D L(.STORE,1) S A="IF $D(@INV@("""_SVAR_"""))" D L(.STORE,1) S A="OTHER "_+FILE(FLVL)_";"_SVAR,SVAR(.01)=SVAR D L(.STORE,1)
. I UFL S A="MATCH "_SVAR_"="_DL_";E" D L(.STORE,1)
I REPEAT,'OTHER D
. I $L(DICOMPX,";")=1,DICOMPX[(+FILE(FLVL)_U_".01") D Q
.. S A="" D L(.STORE,1) S A="IF $D(@INV@("""_SVAR_"""))" D L(.STORE,1) S A="MULT "_$P(^DD(+FILE(FLVL-1),MULTF,0),U)_";"_SVAR,SVAR(.01)=SVAR D L(.STORE,1)
.. S ^UTILITY("INDIA",$J,.01)=MULTF_"///^S X=$E(DIPA("""_SVAR_"""),1,"_ML_")"
. I UFL S A="MATCH "_SVAR_"="_DL_";E" D L(.STORE,1)
I MULT D Q
. S F=$P(DICOMPX,";")
. I MULT'=+FILE(FLVL) S A="S DLAYGO="_MULT D TL S A=$P(F,U,2)_"///"_$E("/",+$P(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")" D TL D Q
.. I INAUDIT S ADL=DL,AMULT=$P(F,U,2),DL="LAST(#"_AMULT_")" D FIELD^INHSGZ22(+FILE(FLVL)) S DL=ADL
.. I '$O(^DD(MULT,.01)) S MULT=0 Q
.. S MULTL=MULTL+1,MULTL(MULTL)=(TEMP-.5)_"^"_SVAR
.. S A=".01///"_$E("/",+$P(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")" D TL S FLVL=FLVL+1,FILE(FLVL)=+MULT Q
. S A=$P(F,U,2)_"///"_$E("/",+$P(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")" D TL
. I INAUDIT S ADL=DL,DL="1ST(#"_AMULT_":#"_$P(F,U,2)_")" D FIELD^INHSGZ22(+FILE(FLVL-1)) S DL=ADL
G:REPEAT!OTHER T
I $L(DICOMPX,";")=1,DICOMPX[(+FILE(FLVL)_U_".01") S IDENT=1 S:'$D(LSR) ^UTILITY("INS",$J,701)="IDENT "_SVAR_"|CR|",^UTILITY("INS",$J,798)="SAVE "_$P(SEG(0),U,2)_".01|CR|" S FSAV(+FILE(FLVL))=$P(SEG(0),U,2)_".01" G T
I UFL S A="MATCH "_SVAR_"="_DL_";E" D L(.LOOKUP,1)
T I $O(^INTHL7F(FIELD,6,0)) S I=0 F S I=$O(^INTHL7F(FIELD,6,I)) Q:'I S A=$P(^(I,0),"|CR|") D:A]"" TL
Q:'DICOMPX D:INAUDIT FIELD^INHSGZ22(+FILE(FLVL)) I REPEAT,'OTHER,DICOMPX[(+FILE(FLVL)_U_".01") Q
F I=$L(DICOMPX,";"):-1:1 S F=$P(DICOMPX,";",I) D
. I I=1 S A=$P(F,U,2)_"///"_$E("/",+$P(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")"_$P(" S:X="""" X=""@""",U,$P(FIELD(0),U,6)) D TL Q
. S A=$P(F,U,2)_":" D TL
I $L(DICOMPX,";")>1 F I=2:1:$L(DICOMPX,";") S A="||" D TL
Q
;
TL ;Place a line in the template
I 'INSYS,A["//^S X=" S TEMP=TEMP+1,^UTILITY("INDIA",$J,TEMP)="K INY "_$P(A,"^",2,99)_" S INY(DP_"",""_"_+A_")=X"
S TEMP=TEMP+1,^UTILITY("INDIA",$J,TEMP)=A Q
;
LINK ;Link up files by adding code to template
;+FILE(FLVL) = current file level
N F,I,J,K
S F=+FILE(FLVL),I="",K=.04
F S I=$O(FSAV(I)) Q:'I D
. Q:'$D(^DD(I,0,"PT",F))
. S J=0 F S J=$O(^DD(I,0,"PT",F,J)) Q:'J S K=K+.01,^UTILITY("INDIA",$J,K)=J_"///^S X=$S($G(@INV@("""_FSAV(I)_"""))>0:""`""_@INV@("""_FSAV(I)_"""),1:"""")"
Q
INHSGZ21 ;JSH; 1 Jul 97 10:20;Continuation of INHSGZ2
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
L(%L,%C) ;Place a line in the global
+1 GOTO L1^INHSGZ2
+2 ;
PROC ;Check if field is to be used in lookup
+1 ;Also look for the .01 field
+2 ;Create template code for it
+3 NEW ML,DL,DA,Y,DQI,X,DICOMPX,I,F,I0
+4 ;I DL="" D WARN^INHSGZ2("Field '"_$P(FIELD(0),U)_"' is missing a data location - IGNORED.") Q
SET DL=$GET(^INTHL7F(FIELD,"C"))
IF DL=""
QUIT
+5 SET ML=$PIECE(^INTHL7F(FIELD,0),U,3)
DIC KILL DIC
SET X=DL
SET DIC="^DD("_+FILE(FLVL)_","
SET DIC(0)="FZ"
SET DIC("S")="I $P(^(0),U,2)'[""C"""
DO ^DIC
IF Y>0
SET DICOMPX=+FILE(FLVL)_U_+Y
SET %=1
Begin DoDot:1
+1 IF '$PIECE(^DD(+FILE(FLVL),+Y,0),U,2)
QUIT
+2 SET MULT=+$PIECE(^(0),U,2)
IF $PIECE(^DD(MULT,.01,0),U,2)["W"
Begin DoDot:2
+3 NEW N
SET N=$PIECE($PIECE(^DD(+FILE(FLVL),+Y,0),U,4),";")
IF $PIECE(FIELD(0),U,4)
Begin DoDot:3
+4 SET A="I $G(DIPA("""_SVAR_"""))]"""" N I,% S %=0,INDIG=DIE_DA_"","""""_N_""""")"" F I=0:0 S:'$O(@INDIG@(I)) ^(I+1,0)=DIPA("""_SVAR_"""),%=1,@INDIG@(0)=U_U_(I+1)_U_(I+1)_U_DT S I=$O(@INDIG@(I)) Q:%"
DO TL
End DoDot:3
QUIT
+5 SET A="I $G(DIPA("""_SVAR_"""))]"""" S INDIG=DIE_DA_"","""""_N_""""")"" K @INDIG S @INDIG@(1,0)=DIPA("""_SVAR_"""),@INDIG@(0)=U_U_1_U_1_U_DT"
DO TL
End DoDot:2
SET (MULT,%)=0
QUIT
End DoDot:1
IF %
GOTO FOK
QUIT
+6 SET J(0)=+FILE(FLVL)
SET I(0)=""
IF '$DATA(^DD(J(0)))
DO ERROR^INHSGZ2("File #"_+FILE_" does not exist.")
QUIT
+7 SET DA="DA("
SET DQI="Y("
SET DICOMPX=""
SET X=DL
IF X
SET X="#"_X
+8 IF $EXTRACT(X)'="@"
DO ^DICOMP
IF '$DATA(X)
IF 'MULT
DO ERROR^INHSGZ2("DATA LOCATION for field '"_$PIECE(FIELD(0),U)_"' is invalid.")
QUIT
+9 IF MULT
SET FLVL=FLVL-1
SET MULT=0
SET A="||"
DO TL
SET MULTL(0)=1
GOTO DIC
FOK IF $GET(MULTL(0))
SET $PIECE(MULTL(MULTL),U,3)=+$PIECE(DICOMPX,U,2)
SET MULTL=MULTL-1
KILL MULTL(0)
+1 IF OTHER
Begin DoDot:1
+2 IF $LENGTH(DICOMPX,";")=1
IF DICOMPX[(+FILE(FLVL)_U_".01")
Begin DoDot:2
+3 SET A=""
DO L(.STORE,1)
SET A="IF $D(@INV@("""_SVAR_"""))"
DO L(.STORE,1)
SET A="OTHER "_+FILE(FLVL)_";"_SVAR
SET SVAR(.01)=SVAR
DO L(.STORE,1)
End DoDot:2
QUIT
+4 IF UFL
SET A="MATCH "_SVAR_"="_DL_";E"
DO L(.STORE,1)
End DoDot:1
+5 IF REPEAT
IF 'OTHER
Begin DoDot:1
+6 IF $LENGTH(DICOMPX,";")=1
IF DICOMPX[(+FILE(FLVL)_U_".01")
Begin DoDot:2
+7 SET A=""
DO L(.STORE,1)
SET A="IF $D(@INV@("""_SVAR_"""))"
DO L(.STORE,1)
SET A="MULT "_$PIECE(^DD(+FILE(FLVL-1),MULTF,0),U)_";"_SVAR
SET SVAR(.01)=SVAR
DO L(.STORE,1)
+8 SET ^UTILITY("INDIA",$JOB,.01)=MULTF_"///^S X=$E(DIPA("""_SVAR_"""),1,"_ML_")"
End DoDot:2
QUIT
+9 IF UFL
SET A="MATCH "_SVAR_"="_DL_";E"
DO L(.STORE,1)
End DoDot:1
+10 IF MULT
Begin DoDot:1
+11 SET F=$PIECE(DICOMPX,";")
+12 IF MULT'=+FILE(FLVL)
SET A="S DLAYGO="_MULT
DO TL
SET A=$PIECE(F,U,2)_"///"_$EXTRACT("/",+$PIECE(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")"
DO TL
Begin DoDot:2
+13 IF INAUDIT
SET ADL=DL
SET AMULT=$PIECE(F,U,2)
SET DL="LAST(#"_AMULT_")"
DO FIELD^INHSGZ22(+FILE(FLVL))
SET DL=ADL
+14 IF '$ORDER(^DD(MULT,.01))
SET MULT=0
QUIT
+15 SET MULTL=MULTL+1
SET MULTL(MULTL)=(TEMP-.5)_"^"_SVAR
+16 SET A=".01///"_$EXTRACT("/",+$PIECE(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")"
DO TL
SET FLVL=FLVL+1
SET FILE(FLVL)=+MULT
QUIT
End DoDot:2
QUIT
+17 SET A=$PIECE(F,U,2)_"///"_$EXTRACT("/",+$PIECE(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")"
DO TL
+18 IF INAUDIT
SET ADL=DL
SET DL="1ST(#"_AMULT_":#"_$PIECE(F,U,2)_")"
DO FIELD^INHSGZ22(+FILE(FLVL-1))
SET DL=ADL
End DoDot:1
QUIT
+19 IF REPEAT!OTHER
GOTO T
+20 IF $LENGTH(DICOMPX,";")=1
IF DICOMPX[(+FILE(FLVL)_U_".01")
SET IDENT=1
IF '$DATA(LSR)
SET ^UTILITY("INS",$JOB,701)="IDENT "_SVAR_"|CR|"
SET ^UTILITY("INS",$JOB,798)="SAVE "_$PIECE(SEG(0),U,2)_".01|CR|"
SET FSAV(+FILE(FLVL))=$PIECE(SEG(0),U,2)_".01"
GOTO T
+21 IF UFL
SET A="MATCH "_SVAR_"="_DL_";E"
DO L(.LOOKUP,1)
T IF $ORDER(^INTHL7F(FIELD,6,0))
SET I=0
FOR
SET I=$ORDER(^INTHL7F(FIELD,6,I))
IF 'I
QUIT
SET A=$PIECE(^(I,0),"|CR|")
IF A]""
DO TL
+1 IF 'DICOMPX
QUIT
IF INAUDIT
DO FIELD^INHSGZ22(+FILE(FLVL))
IF REPEAT
IF 'OTHER
IF DICOMPX[(+FILE(FLVL)_U_".01")
QUIT
+2 FOR I=$LENGTH(DICOMPX,";"):-1:1
SET F=$PIECE(DICOMPX,";",I)
Begin DoDot:1
+3 IF I=1
SET A=$PIECE(F,U,2)_"///"_$EXTRACT("/",+$PIECE(FIELD(0),U,5))_"^S X=$E($G(DIPA("""_SVAR_""")),1,"_ML_")"_$PIECE(" S:X="""" X=""@""",U,$PIECE(FIELD(0),U,6))
DO TL
QUIT
+4 SET A=$PIECE(F,U,2)_":"
DO TL
End DoDot:1
+5 IF $LENGTH(DICOMPX,";")>1
FOR I=2:1:$LENGTH(DICOMPX,";")
SET A="||"
DO TL
+6 QUIT
+7 ;
TL ;Place a line in the template
+1 IF 'INSYS
IF A["//^S X="
SET TEMP=TEMP+1
SET ^UTILITY("INDIA",$JOB,TEMP)="K INY "_$PIECE(A,"^",2,99)_" S INY(DP_"",""_"_+A_")=X"
+2 SET TEMP=TEMP+1
SET ^UTILITY("INDIA",$JOB,TEMP)=A
QUIT
+3 ;
LINK ;Link up files by adding code to template
+1 ;+FILE(FLVL) = current file level
+2 NEW F,I,J,K
+3 SET F=+FILE(FLVL)
SET I=""
SET K=.04
+4 FOR
SET I=$ORDER(FSAV(I))
IF 'I
QUIT
Begin DoDot:1
+5 IF '$DATA(^DD(I,0,"PT",F))
QUIT
+6 SET J=0
FOR
SET J=$ORDER(^DD(I,0,"PT",F,J))
IF 'J
QUIT
SET K=K+.01
SET ^UTILITY("INDIA",$JOB,K)=J_"///^S X=$S($G(@INV@("""_FSAV(I)_"""))>0:""`""_@INV@("""_FSAV(I)_"""),1:"""")"
End DoDot:1
+7 QUIT
