INHSGZ2 ;JSH,DGH; 21 Jan 2000 17:18 ;Interface - script generator for INPUT scripts
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;CHCS TOOLS_460; GEN 8; 17-JUL-1997
;COPYRIGHT 1988, 1989, 1990 SAIC
;
L(%L,%C) ;Place a line in the global
;%L = node after which to place the line of code
;%C = 1: place |CR| at the end 0: do not place |CR| at the end
L1 I $D(LSR),%L>699 Q
S %L=%L+.1,^UTILITY("INS",$J,%L)=A_$P("|CR|",U,$G(%C)) Q
;
IN ;Enter here with:
; FILE = file #
; MESS = entry # of message
; MESS(0) = zero node of message file entry
;
;Return with lines of script in ^UTILITY("INS",$J,n) [n=1,2,3...]
; ERR is set on return. 0 = no errors occured 1 = there was an error
;
D K,EN
K K DATA,TRANS,REQUIRED,A,SEG,FIELD,DTY,REQ,GL,TEMP,LOOKUP,IDENT,UFL,SVAR,OTHER,MULT,REPEAT,MULTF,MUMPS,SCODE,FLVL,SEGC,ROUTINE,FSAV,NOSTORE,GROUP,MULTL,INSYS,INAUDIT,STORE,LSR,SLVL,NOLS,LVAR Q
EN S (GROUP,FLVL,REPEAT,MULT,IDENT,DATA,SLVL)=0,TRANS=500,REQUIRED=600,LOOKUP=702,STORE=800,A="TRANS:" D L(.TRANS,1) S A="REQUIRED:" D L(.REQUIRED,1)
S FILE(0)=FILE_U_^DIC(+FILE,0,"GL"),INSYS=$$SC^INHUTIL1,INAUDIT=+$P(MESS(0),"^",9) D:INAUDIT INIT^INHSGZ22
S INSTD=$G(INSTD,"HL7")
S A=";Generated from '"_$P(MESS(0),U)_"' "_INSTD_" message." D L(.DATA,1)
S A="DATA:" D L(.DATA,1) I INAUDIT S A="^S INAUDIT=''$D(^INVQA(UIF)) I INAUDIT K ^UTILITY(""INVAUD"",$J) D INIT^"_ARNAME D L(.DATA,1)
I $G(INSTD)="HL" S A="DELIM=$E(DATA,4)" D L(.DATA,1) S A="SUBDELIM=$E(DATA,5)" D L(.DATA,1) S A="" D L(.DATA,1)
;Hard-code NCPDP delimiter
I $G(INSTD)="NC" S A="DELIM=""^""" D L(.DATA,1) S A="" D L(.DATA,1)
;Find X12 delimiters in ISA
I $G(INSTD)="X12" S A="DELIM=$E(DATA,4)" D L(.DATA,1) S A="SUBDELIM=$E(DATA,105)" D L(.DATA,1) S A="" D L(.DATA,1)
SEGARRY ;Set up array of defined segments
;
N SLVL,IDX,INSG
S A="^N INDEFSEG" D L(.DATA,1)
S SLVL=0
S INS="" F S INS=$O(^INTHL7M(MESS,1,"AS",INS)) Q:'INS S X=$O(^(INS,0)),MESS(1)=^INTHL7M(MESS,1,X,0) D:'$P(MESS(1),U,11) SEG1(X)
;
S:$G(^INTHL7M(MESS,5))]"" LSR=^(5) ;FRW
S INS="",SEGC=0,STL=800 F S INS=$O(^INTHL7M(MESS,1,"AS",INS)) Q:'INS S X=$O(^(INS,0)),MESS(1)=^INTHL7M(MESS,1,X,0) D:'$P(MESS(1),U,11) SEG(X) Q:ERR
Q:ERR
I GROUP S A="ENDGROUP" D L(.DATA,1) S GROUP=0
I '$D(LSR) S ^UTILITY("INS",$J,700)="LOOKUP:|CR|",^(800)="STORE:|CR|" S:$P(MESS(0),U,7)]"" ^(702)="PARAM "_$S($P(MESS(0),U,7)="O":"N",1:$P(MESS(0),U,7))_"|CR|" D
. I $O(^INTHL7M(MESS,4,0)) S I=0 F S I=$O(^INTHL7M(MESS,4,I)) Q:'I I ^(I,0)]"" S A="^"_$P(^(0),"|CR|")_"|CR|" D L(.LOOKUP,1)
S:$D(LSR) ^UTILITY("INS",$J,700)="^Q:$G(INSTERR) $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR) D "_$$LBTB^UTIL(LSR)_"|CR|"
I INAUDIT S A="^I INAUDIT S %X=$S(INV["")"":$E(INV,1,$L(INV)),1:INV),%Y=""^UTILITY(""""INVAUD"""",$J)"" M @%Y=@%X" D L(.DATA,1)
F I=499,599,699,799,9999 S ^UTILITY("INS",$J,I)="|CR|"
S ^UTILITY("INS",$J,10000)="END:|CR|" I INAUDIT S ^UTILITY("INS",$J,9999.999)="^I INAUDIT D FINISH^"_ARNAME_"|CR|" D FILE^INHSGZ22
Q
;
SEG(SEG) ;Process segment
;SEG = IEN in segment multiple of message
S MESS(1)=^INTHL7M(MESS,1,SEG,0),SEG(2)=SEG,SEG=+MESS(1)
Q:'$D(^INTHL7S(SEG,0)) S SEG(0)=^(0)
K ^UTILITY("INDIA",$J) N MULTL,OTHER,REPEAT,MUMPS,SCODE,ROUTINE,NOSTORE,WP,MULTF,CH
N LOOPST,LOOPDAD,LOOPID,NODATA,INCOUNT,ALIAS,LOOPREC,LOOPM1,LOOPM2
S (MULTL,TEMP)=0
;Set NCPDP variables for id field and id value
I $G(INSTD)="NC" S INIDF=$P(MESS(1),U,18),INIDV=$P(MESS(1),U,19)
S NOLS=0 I $P(MESS(1),U,7)="P" S NOLS=1,OTHER="",REPEAT=$P(MESS(1),U,3),NOSTORE=1 K SVAR(.01) S:REPEAT SVAR(.01)=$P(SEG(0),U,2)_1,SLVL=SLVL+1 G NOLS
S OTHER=$P(MESS(1),U,4,99) S:OTHER FLVL=FLVL+1,FILE(FLVL)=$P(OTHER,U,2)_U_^DIC($P(OTHER,U,2),0,"GL")
S REPEAT=$P(MESS(1),U,3),MUMPS="^INTHL7M("_+MESS_",1,"_SEG(2)_",1)",SCODE="^INTHL7M("_+MESS_",1,"_SEG(2)_",2)",ROUTINE="^INTHL7M("_+MESS_",1,"_SEG(2)_",3)"
S NOSTORE=$S('OTHER&'REPEAT:$P(MESS(0),U,7)="O",1:$P(OTHER,U,4)="O")!$D(LSR)
I REPEAT,'OTHER K DIC S WP=0,DIC="^DD("_+FILE(FLVL)_",",DIC(0)="F",X=$P(OTHER,U,5) D Q:WP
. D ^DIC I Y<0 D ERROR("Multiple field '"_$P(OTHER,U,5)_"' not found for segment: "_$P(SEG(0),U)) Q
. S MULTF=+Y,FLVL=FLVL+1,FILE(FLVL)=+$P(^DD(+FILE(FLVL-1),+Y,0),U,2)_U_FILE(FLVL-1)_"INDA(""S"")," I 'FILE(FLVL) D ERROR("Field '"_$P(OTHER,U,5)_"' is not a multiple.") Q
. I $P(^DD(+FILE(FLVL),.01,0),U,2)["W" S WP=1 D WP^INHSGZ20 Q
Q:ERR S:REPEAT SLVL=SLVL+1 D:INAUDIT SEGINIT^INHSGZ22
NOLS S A=";'"_$P(SEG(0),U,2)_"' segment" D L(.DATA,1)
S CP=0,CL="LINE("_$P(SEG(0),U,2)_"*) "
;If NCPDP, Set specialized LINE before "normal" LINE.
I $G(INSTD)="NC",INIDF S A="LINE NCID "_INIDF_"="_INIDV D L(.DATA,1)
;If standard is HL7 or NCPDP, use HL7s group logic
I $G(INSTD)'="X1" D
.I REPEAT S CL="LINE ",A="ENDGROUP" D:GROUP L(.DATA,1) S GROUP=0,A="WHILE "_$S($P(MESS(1),U,9):"~REQUIRED~ ",1:"")_"$P(DATA,DELIM)="""_$P(SEG(0),U,2)_"""" D L(.DATA,1)
.I 'REPEAT,'GROUP,'$P(MESS(1),U,11) S A="GROUP" D L(.DATA,1) S GROUP=1
;Establish transform section based on correct standard
;I $G(INSTD)'["NC" S A="IF $D(@INV@("""_$P(SEG(0),U,2)_"1""))" D L(.TRANS,1)
D:$G(INSTD)'["NC"
.N FF,FIELD S FF=1
.S FIELD=+$O(^INTHL7S(SEG,1,"AS",0)),FIELD=+$O(^INTHL7S(SEG,1,"AS",FIELD,0))
.S FIELD=+$G(^INTHL7S(SEG,1,FIELD,0))
.S:$O(^INTHL7F(FIELD,10,0)) FF=1.1
.S A="IF $D(@INV@("""_$P(SEG(0),U,2)_FF_"""))" D L(.TRANS,1)
I $G(INSTD)="NC" S A="IF $D(@INV@("""_$P(SEG(0),U,2)_"""))" D L(.TRANS,1)
K REPEAT("REQ") K:'NOLS SVAR(.01) S (INF0,INF)=""
F S INF0=$O(^INTHL7S(SEG,1,"AS",INF0)) Q:'INF0 S INF=INF0,X=$O(^(INF0,0)),(SEG(1),Y)=^INTHL7S(SEG,1,X,0),FIELD=+Y,REQ=$P(Y,U,3),UFL=$P(Y,U,5) D:$D(^INTHL7F(FIELD,0)) FIELD^INHSGZ20 Q:ERR
Q:ERR ;quit if there was an error in the field processing
I CL]"" S A=CL D L(.DATA,1)
;If end-of-segment processing is needed, insert here
I MULT S FLVL=FLVL-1,MULT=0,A="||" D:'FLVL TL^INHSGZ21
K T S T1=$TR($P(OTHER,U,3),"[]") I T1="",'NOSTORE,$O(^UTILITY("INDIA",$J,.01)) D
. N T1 S SEGC=SEGC+1,T="IU"_$E(SCR#1000+1000,2,5)_$C($S(SEGC<27:64,1:70)+SEGC)
. N I S I=0 F S I=$O(MULTL(I)) Q:'I S ^UTILITY("INDIA",$J,+MULTL(I))="S:$G(DIPA("""_$P(MULTL(I),U,2)_"""))="""" Y="""_$P(MULTL(I),U,3)_""""_$S($P(MULTL(I),U,3)="":",INEXIT=1",1:"")
. W !,"Creating and Compiling Input Template: "_T S F=$S(REPEAT&'OTHER:FLVL-1,1:FLVL) D:$P(OTHER,U,7) LINK^INHSGZ21 D ^INHDIA(T,+FILE(F)_^DIC(+FILE(F),0,"GL")) W !
I 'OTHER,'REPEAT,'NOLS D
. S:'SEGC SEGC=SEGC+1 S A="IF $D(@INV@("""_$P(SEG(0),U,2)_1_"""))" D L(.STORE,1) I $D(T)!(T1]"") S A="TEMPLATE=["_$S(T1]"":T1,1:T)_"]" D L(.STORE,1)
. I $G(@ROUTINE)]"" S A="ROUTINE= ^"_@ROUTINE D L(.STORE,1)
. I INAUDIT S Z=ARSEG($P(SEG(0),U,2)),A="IF INAUDIT" D L(.STORE,1) S A="ROUTINE= "_$P(SEG(0),U,2)_U_ARNAME_$S(Z>1:$C(63+Z),1:"") D L(.STORE,1) S A="ENDIF" D L(.STORE,1)
. S A="ENDIF" D L(.STORE,1)
. I $O(@SCODE@(0)) S I=0 F S I=$O(@SCODE@(I)) Q:'I S A=$P(@SCODE@(I,0),"|CR|") D:$L(A) L(.LOOKUP,1)
. I $O(@MUMPS@(0)) S I=0 F S I=$O(@MUMPS@(I)) Q:'I S A="^"_$P(@MUMPS@(I,0),"|CR|") D:$L(A) L(.LOOKUP,1)
I $D(REPEAT("REQ")),$D(SVAR(.01)) D
. S I="" F S I=$O(REPEAT("REQ",I)) Q:I="" S A=I_"^"_SVAR(.01)_$S('$P(MESS(1),U,9):"^D KILL^INHVA1("""_$P(SEG(0),U,2)_""","""_REPEAT("REQ",I)_""",.INI)",1:" ;"_REPEAT("REQ",I)) D L(.REQUIRED,1)
I 'NOLS D:OTHER!REPEAT ROPOST^INHSGZ20 D:INAUDIT SEGEND^INHSGZ22
I $D(^INTHL7M(MESS,1,"ASP",SEG)) S CH=0 F S CH=$O(^INTHL7M(MESS,1,"ASP",SEG,CH)) Q:'CH D SEG($O(^(CH,0)))
S A="ENDIF" D L(.TRANS,1) S A="" D L(.TRANS,1)
I REPEAT S A="ENDWHILE" D L(.DATA,1) S SLVL=SLVL-1
I 'NOLS D:OTHER!REPEAT ROPOST1^INHSGZ20
Q
;
SEG1(SEG) ;Process segment
;SEG = IEN in segment multiple of message
S MESS(1)=^INTHL7M(MESS,1,SEG,0),SEG=+MESS(1)
Q:'$D(^INTHL7S(SEG,0)) S SEG(0)=^(0)
N REPEAT,CH
S REPEAT=$P(MESS(1),U,3) S:REPEAT SLVL=SLVL+1 G NOLS1
Q
;
NOLS1 ; Recursively process child segment if applicable
S INSG=$P(SEG(0),U,2)
S A="^S INDEFSEG("""_INSG_""","_SLVL_")="_+$P(MESS(1),U,3) D L(.DATA,1)
I $D(^INTHL7M(MESS,1,"ASP",SEG)) S CH=0 F S CH=$O(^INTHL7M(MESS,1,"ASP",SEG,CH)) Q:'CH D SEG1($O(^(CH,0)))
I REPEAT S SLVL=SLVL-1
Q
;
ERROR(%M) ;Process an error
;%M = error text
W !,*7,"ERROR: "_$G(%M) S ERR=1 Q
;
WARN(%M) ;Display a warning
;%M = warning text
W !,*7,"WARNING: "_$G(%M) Q
INHSGZ2 ;JSH,DGH; 21 Jan 2000 17:18 ;Interface - script generator for INPUT scripts
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;CHCS TOOLS_460; GEN 8; 17-JUL-1997
+4 ;COPYRIGHT 1988, 1989, 1990 SAIC
+5 ;
L(%L,%C) ;Place a line in the global
+1 ;%L = node after which to place the line of code
+2 ;%C = 1: place |CR| at the end 0: do not place |CR| at the end
L1 IF $DATA(LSR)
IF %L>699
QUIT
+1 SET %L=%L+.1
SET ^UTILITY("INS",$JOB,%L)=A_$PIECE("|CR|",U,$GET(%C))
QUIT
+2 ;
IN ;Enter here with:
+1 ; FILE = file #
+2 ; MESS = entry # of message
+3 ; MESS(0) = zero node of message file entry
+4 ;
+5 ;Return with lines of script in ^UTILITY("INS",$J,n) [n=1,2,3...]
+6 ; ERR is set on return. 0 = no errors occured 1 = there was an error
+7 ;
+8 DO K
DO EN
K KILL DATA,TRANS,REQUIRED,A,SEG,FIELD,DTY,REQ,GL,TEMP,LOOKUP,IDENT,UFL,SVAR,OTHER,MULT,REPEAT,MULTF,MUMPS,SCODE,FLVL,SEGC,ROUTINE,FSAV,NOSTORE,GROUP,MULTL,INSYS,INAUDIT,STORE,LSR,SLVL,NOLS,LVAR
QUIT
EN SET (GROUP,FLVL,REPEAT,MULT,IDENT,DATA,SLVL)=0
SET TRANS=500
SET REQUIRED=600
SET LOOKUP=702
SET STORE=800
SET A="TRANS:"
DO L(.TRANS,1)
SET A="REQUIRED:"
DO L(.REQUIRED,1)
+1 SET FILE(0)=FILE_U_^DIC(+FILE,0,"GL")
SET INSYS=$$SC^INHUTIL1
SET INAUDIT=+$PIECE(MESS(0),"^",9)
IF INAUDIT
DO INIT^INHSGZ22
+2 SET INSTD=$GET(INSTD,"HL7")
+3 SET A=";Generated from '"_$PIECE(MESS(0),U)_"' "_INSTD_" message."
DO L(.DATA,1)
+4 SET A="DATA:"
DO L(.DATA,1)
IF INAUDIT
SET A="^S INAUDIT=''$D(^INVQA(UIF)) I INAUDIT K ^UTILITY(""INVAUD"",$J) D INIT^"_ARNAME
DO L(.DATA,1)
+5 IF $GET(INSTD)="HL"
SET A="DELIM=$E(DATA,4)"
DO L(.DATA,1)
SET A="SUBDELIM=$E(DATA,5)"
DO L(.DATA,1)
SET A=""
DO L(.DATA,1)
+6 ;Hard-code NCPDP delimiter
+7 IF $GET(INSTD)="NC"
SET A="DELIM=""^"""
DO L(.DATA,1)
SET A=""
DO L(.DATA,1)
+8 ;Find X12 delimiters in ISA
+9 IF $GET(INSTD)="X12"
SET A="DELIM=$E(DATA,4)"
DO L(.DATA,1)
SET A="SUBDELIM=$E(DATA,105)"
DO L(.DATA,1)
SET A=""
DO L(.DATA,1)
SEGARRY ;Set up array of defined segments
+1 ;
+2 NEW SLVL,IDX,INSG
+3 SET A="^N INDEFSEG"
DO L(.DATA,1)
+4 SET SLVL=0
+5 SET INS=""
FOR
SET INS=$ORDER(^INTHL7M(MESS,1,"AS",INS))
IF 'INS
QUIT
SET X=$ORDER(^(INS,0))
SET MESS(1)=^INTHL7M(MESS,1,X,0)
IF '$PIECE(MESS(1),U,11)
DO SEG1(X)
+6 ;
+7 ;FRW
IF $GET(^INTHL7M(MESS,5))]""
SET LSR=^(5)
+8 SET INS=""
SET SEGC=0
SET STL=800
FOR
SET INS=$ORDER(^INTHL7M(MESS,1,"AS",INS))
IF 'INS
QUIT
SET X=$ORDER(^(INS,0))
SET MESS(1)=^INTHL7M(MESS,1,X,0)
IF '$PIECE(MESS(1),U,11)
DO SEG(X)
IF ERR
QUIT
+9 IF ERR
QUIT
+10 IF GROUP
SET A="ENDGROUP"
DO L(.DATA,1)
SET GROUP=0
+11 IF '$DATA(LSR)
SET ^UTILITY("INS",$JOB,700)="LOOKUP:|CR|"
SET ^(800)="STORE:|CR|"
IF $PIECE(MESS(0),U,7)]""
SET ^(702)="PARAM "_$SELECT($PIECE(MESS(0),U,7)="O":"N",1:$PIECE(MESS(0),U,7))_"|CR|"
Begin DoDot:1
+12 IF $ORDER(^INTHL7M(MESS,4,0))
SET I=0
FOR
SET I=$ORDER(^INTHL7M(MESS,4,I))
IF 'I
QUIT
IF ^(I,0)]""
SET A="^"_$PIECE(^(0),"|CR|")_"|CR|"
DO L(.LOOKUP,1)
End DoDot:1
+13 IF $DATA(LSR)
SET ^UTILITY("INS",$JOB,700)="^Q:$G(INSTERR) $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR) D "_$$LBTB^UTIL(LSR)_"|CR|"
+14 IF INAUDIT
SET A="^I INAUDIT S %X=$S(INV["")"":$E(INV,1,$L(INV)),1:INV),%Y=""^UTILITY(""""INVAUD"""",$J)"" M @%Y=@%X"
DO L(.DATA,1)
+15 FOR I=499,599,699,799,9999
SET ^UTILITY("INS",$JOB,I)="|CR|"
+16 SET ^UTILITY("INS",$JOB,10000)="END:|CR|"
IF INAUDIT
SET ^UTILITY("INS",$JOB,9999.999)="^I INAUDIT D FINISH^"_ARNAME_"|CR|"
DO FILE^INHSGZ22
+17 QUIT
+18 ;
SEG(SEG) ;Process segment
+1 ;SEG = IEN in segment multiple of message
+2 SET MESS(1)=^INTHL7M(MESS,1,SEG,0)
SET SEG(2)=SEG
SET SEG=+MESS(1)
+3 IF '$DATA(^INTHL7S(SEG,0))
QUIT
SET SEG(0)=^(0)
+4 KILL ^UTILITY("INDIA",$JOB)
NEW MULTL,OTHER,REPEAT,MUMPS,SCODE,ROUTINE,NOSTORE,WP,MULTF,CH
+5 NEW LOOPST,LOOPDAD,LOOPID,NODATA,INCOUNT,ALIAS,LOOPREC,LOOPM1,LOOPM2
+6 SET (MULTL,TEMP)=0
+7 ;Set NCPDP variables for id field and id value
+8 IF $GET(INSTD)="NC"
SET INIDF=$PIECE(MESS(1),U,18)
SET INIDV=$PIECE(MESS(1),U,19)
+9 SET NOLS=0
IF $PIECE(MESS(1),U,7)="P"
SET NOLS=1
SET OTHER=""
SET REPEAT=$PIECE(MESS(1),U,3)
SET NOSTORE=1
KILL SVAR(.01)
IF REPEAT
SET SVAR(.01)=$PIECE(SEG(0),U,2)_1
SET SLVL=SLVL+1
GOTO NOLS
+10 SET OTHER=$PIECE(MESS(1),U,4,99)
IF OTHER
SET FLVL=FLVL+1
SET FILE(FLVL)=$PIECE(OTHER,U,2)_U_^DIC($PIECE(OTHER,U,2),0,"GL")
+11 SET REPEAT=$PIECE(MESS(1),U,3)
SET MUMPS="^INTHL7M("_+MESS_",1,"_SEG(2)_",1)"
SET SCODE="^INTHL7M("_+MESS_",1,"_SEG(2)_",2)"
SET ROUTINE="^INTHL7M("_+MESS_",1,"_SEG(2)_",3)"
+12 SET NOSTORE=$SELECT('OTHER&'REPEAT:$PIECE(MESS(0),U,7)="O",1:$PIECE(OTHER,U,4)="O")!$DATA(LSR)
+13 IF REPEAT
IF 'OTHER
KILL DIC
SET WP=0
SET DIC="^DD("_+FILE(FLVL)_","
SET DIC(0)="F"
SET X=$PIECE(OTHER,U,5)
Begin DoDot:1
+14 DO ^DIC
IF Y<0
DO ERROR("Multiple field '"_$PIECE(OTHER,U,5)_"' not found for segment: "_$PIECE(SEG(0),U))
QUIT
+15 SET MULTF=+Y
SET FLVL=FLVL+1
SET FILE(FLVL)=+$PIECE(^DD(+FILE(FLVL-1),+Y,0),U,2)_U_FILE(FLVL-1)_"INDA(""S""),"
IF 'FILE(FLVL)
DO ERROR("Field '"_$PIECE(OTHER,U,5)_"' is not a multiple.")
QUIT
+16 IF $PIECE(^DD(+FILE(FLVL),.01,0),U,2)["W"
SET WP=1
DO WP^INHSGZ20
QUIT
End DoDot:1
IF WP
QUIT
+17 IF ERR
QUIT
IF REPEAT
SET SLVL=SLVL+1
IF INAUDIT
DO SEGINIT^INHSGZ22
NOLS SET A=";'"_$PIECE(SEG(0),U,2)_"' segment"
DO L(.DATA,1)
+1 SET CP=0
SET CL="LINE("_$PIECE(SEG(0),U,2)_"*) "
+2 ;If NCPDP, Set specialized LINE before "normal" LINE.
+3 IF $GET(INSTD)="NC"
IF INIDF
SET A="LINE NCID "_INIDF_"="_INIDV
DO L(.DATA,1)
+4 ;If standard is HL7 or NCPDP, use HL7s group logic
+5 IF $GET(INSTD)'="X1"
Begin DoDot:1
+6 IF REPEAT
SET CL="LINE "
SET A="ENDGROUP"
IF GROUP
DO L(.DATA,1)
SET GROUP=0
SET A="WHILE "_$SELECT($PIECE(MESS(1),U,9):"~REQUIRED~ ",1:"")_"$P(DATA,DELIM)="""_$PIECE(SEG(0),U,2)_""""
DO L(.DATA,1)
+7 IF 'REPEAT
IF 'GROUP
IF '$PIECE(MESS(1),U,11)
SET A="GROUP"
DO L(.DATA,1)
SET GROUP=1
End DoDot:1
+8 ;Establish transform section based on correct standard
+9 ;I $G(INSTD)'["NC" S A="IF $D(@INV@("""_$P(SEG(0),U,2)_"1""))" D L(.TRANS,1)
+10 IF $GET(INSTD)'["NC"
Begin DoDot:1
+11 NEW FF,FIELD
SET FF=1
+12 SET FIELD=+$ORDER(^INTHL7S(SEG,1,"AS",0))
SET FIELD=+$ORDER(^INTHL7S(SEG,1,"AS",FIELD,0))
+13 SET FIELD=+$GET(^INTHL7S(SEG,1,FIELD,0))
+14 IF $ORDER(^INTHL7F(FIELD,10,0))
SET FF=1.1
+15 SET A="IF $D(@INV@("""_$PIECE(SEG(0),U,2)_FF_"""))"
DO L(.TRANS,1)
End DoDot:1
+16 IF $GET(INSTD)="NC"
SET A="IF $D(@INV@("""_$PIECE(SEG(0),U,2)_"""))"
DO L(.TRANS,1)
+17 KILL REPEAT("REQ")
IF 'NOLS
KILL SVAR(.01)
SET (INF0,INF)=""
+18 FOR
SET INF0=$ORDER(^INTHL7S(SEG,1,"AS",INF0))
IF 'INF0
QUIT
SET INF=INF0
SET X=$ORDER(^(INF0,0))
SET (SEG(1),Y)=^INTHL7S(SEG,1,X,0)
SET FIELD=+Y
SET REQ=$PIECE(Y,U,3)
SET UFL=$PIECE(Y,U,5)
IF $DATA(^INTHL7F(FIELD,0))
DO FIELD^INHSGZ20
IF ERR
QUIT
+19 ;quit if there was an error in the field processing
IF ERR
QUIT
+20 IF CL]""
SET A=CL
DO L(.DATA,1)
+21 ;If end-of-segment processing is needed, insert here
+22 IF MULT
SET FLVL=FLVL-1
SET MULT=0
SET A="||"
IF 'FLVL
DO TL^INHSGZ21
+23 KILL T
SET T1=$TRANSLATE($PIECE(OTHER,U,3),"[]")
IF T1=""
IF 'NOSTORE
IF $ORDER(^UTILITY("INDIA",$JOB,.01))
Begin DoDot:1
+24 NEW T1
SET SEGC=SEGC+1
SET T="IU"_$EXTRACT(SCR#1000+1000,2,5)_$CHAR($SELECT(SEGC<27:64,1:70)+SEGC)
+25 NEW I
SET I=0
FOR
SET I=$ORDER(MULTL(I))
IF 'I
QUIT
SET ^UTILITY("INDIA",$JOB,+MULTL(I))="S:$G(DIPA("""_$PIECE(MULTL(I),U,2)_"""))="""" Y="""_$PIECE(MULTL(I),U,3)_""""_$SELECT($PIECE(MULTL(I),U,3)="":",INEXIT=1",1:"")
+26 WRITE !,"Creating and Compiling Input Template: "_T
SET F=$SELECT(REPEAT&'OTHER:FLVL-1,1:FLVL)
IF $PIECE(OTHER,U,7)
DO LINK^INHSGZ21
DO ^INHDIA(T,+FILE(F)_^DIC(+FILE(F),0,"GL"))
WRITE !
End DoDot:1
+27 IF 'OTHER
IF 'REPEAT
IF 'NOLS
Begin DoDot:1
+28 IF 'SEGC
SET SEGC=SEGC+1
SET A="IF $D(@INV@("""_$PIECE(SEG(0),U,2)_1_"""))"
DO L(.STORE,1)
IF $DATA(T)!(T1]"")
SET A="TEMPLATE=["_$SELECT(T1]"":T1,1:T)_"]"
DO L(.STORE,1)
+29 IF $GET(@ROUTINE)]""
SET A="ROUTINE= ^"_@ROUTINE
DO L(.STORE,1)
+30 IF INAUDIT
SET Z=ARSEG($PIECE(SEG(0),U,2))
SET A="IF INAUDIT"
DO L(.STORE,1)
SET A="ROUTINE= "_$PIECE(SEG(0),U,2)_U_ARNAME_$SELECT(Z>1:$CHAR(63+Z),1:"")
DO L(.STORE,1)
SET A="ENDIF"
DO L(.STORE,1)
+31 SET A="ENDIF"
DO L(.STORE,1)
+32 IF $ORDER(@SCODE@(0))
SET I=0
FOR
SET I=$ORDER(@SCODE@(I))
IF 'I
QUIT
SET A=$PIECE(@SCODE@(I,0),"|CR|")
IF $LENGTH(A)
DO L(.LOOKUP,1)
+33 IF $ORDER(@MUMPS@(0))
SET I=0
FOR
SET I=$ORDER(@MUMPS@(I))
IF 'I
QUIT
SET A="^"_$PIECE(@MUMPS@(I,0),"|CR|")
IF $LENGTH(A)
DO L(.LOOKUP,1)
End DoDot:1
+34 IF $DATA(REPEAT("REQ"))
IF $DATA(SVAR(.01))
Begin DoDot:1
+35 SET I=""
FOR
SET I=$ORDER(REPEAT("REQ",I))
IF I=""
QUIT
SET A=I_"^"_SVAR(.01)_$SELECT('$PIECE(MESS(1),U,9):"^D KILL^INHVA1("""_$PIECE(SEG(0),U,2)_""","""_REPEAT("REQ",I)_""",.INI)",1:" ;"_REPEAT("REQ",I))
DO L(.REQUIRED,1)
End DoDot:1
+36 IF 'NOLS
IF OTHER!REPEAT
DO ROPOST^INHSGZ20
IF INAUDIT
DO SEGEND^INHSGZ22
+37 IF $DATA(^INTHL7M(MESS,1,"ASP",SEG))
SET CH=0
FOR
SET CH=$ORDER(^INTHL7M(MESS,1,"ASP",SEG,CH))
IF 'CH
QUIT
DO SEG($ORDER(^(CH,0)))
+38 SET A="ENDIF"
DO L(.TRANS,1)
SET A=""
DO L(.TRANS,1)
+39 IF REPEAT
SET A="ENDWHILE"
DO L(.DATA,1)
SET SLVL=SLVL-1
+40 IF 'NOLS
IF OTHER!REPEAT
DO ROPOST1^INHSGZ20
+41 QUIT
+42 ;
SEG1(SEG) ;Process segment
+1 ;SEG = IEN in segment multiple of message
+2 SET MESS(1)=^INTHL7M(MESS,1,SEG,0)
SET SEG=+MESS(1)
+3 IF '$DATA(^INTHL7S(SEG,0))
QUIT
SET SEG(0)=^(0)
+4 NEW REPEAT,CH
+5 SET REPEAT=$PIECE(MESS(1),U,3)
IF REPEAT
SET SLVL=SLVL+1
GOTO NOLS1
+6 QUIT
+7 ;
NOLS1 ; Recursively process child segment if applicable
+1 SET INSG=$PIECE(SEG(0),U,2)
+2 SET A="^S INDEFSEG("""_INSG_""","_SLVL_")="_+$PIECE(MESS(1),U,3)
DO L(.DATA,1)
+3 IF $DATA(^INTHL7M(MESS,1,"ASP",SEG))
SET CH=0
FOR
SET CH=$ORDER(^INTHL7M(MESS,1,"ASP",SEG,CH))
IF 'CH
QUIT
DO SEG1($ORDER(^(CH,0)))
+4 IF REPEAT
SET SLVL=SLVL-1
+5 QUIT
+6 ;
ERROR(%M) ;Process an error
+1 ;%M = error text
+2 WRITE !,*7,"ERROR: "_$GET(%M)
SET ERR=1
QUIT
+3 ;
WARN(%M) ;Display a warning
+1 ;%M = warning text
+2 WRITE !,*7,"WARNING: "_$GET(%M)
QUIT
