- 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