- IS00007H ;Compiled from script 'Generated: HL IHS DW1 A08-O' on SEP 08, 2008
- ;Part 9
- ;Copyright 2008 SAIC
- EN S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,15,L1,.CP) S L1=$G(@INV@("PR115")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
- S L1=$G(@INV@("PR116")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP) S L1=$G(@INV@("PR117")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP) S L1=$G(@INV@("PR118")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,19,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- S INDA1=INDA,INI(2)=0 F S INI(2)=$O(INDA("ZPR",INI(2))) Q:'INI(2) S INDA=$S(INDA("ZPR",INI(2)):INDA("ZPR",INI(2)),1:INI(2)) D
- .;SET ZPR1 = ""
- .S D0=INDA S X=""
- .S @INV@("ZPR1")=X K DXS,D0
- .;SET ZPR2 = ""
- .S D0=INDA S X=""
- .S @INV@("ZPR2")=X K DXS,D0
- .;SET ZPR3 = ""
- .S D0=INDA S X=""
- .S @INV@("ZPR3")=X K DXS,D0
- .;SET ZPR4 = ""
- .S D0=INDA S X=""
- .S @INV@("ZPR4")=X K DXS,D0
- .;SET ZPR5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR5
- .S D0=INDA S X=$G(INA("BDW1ZPR5",INI(1),INI(2)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZPR5")=X K DXS,D0
- .;SET ZPR6 = ""
- .S D0=INDA S X=""
- .S @INV@("ZPR6")=X K DXS,D0
- .;SET ZPR7 = ""
- .S D0=INDA S X=""
- .S @INV@("ZPR7")=X K DXS,D0
- .;SET ZPR8 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR8
- .S D0=INDA S X=$G(INA("BDW1ZPR8",INI(1),INI(2)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZPR8")=X K DXS,D0
- .;SET ZPR9 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR9
- .S D0=INDA S X=$G(INA("BDW1ZPR9",INI(1),INI(2)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZPR9")=X K DXS,D0
- .;SET ZPR10 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR10
- .S D0=INDA S X=$G(INA("BDW1ZPR10",INI(1),INI(2)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZPR10")=X K DXS,D0
- .;SET ZPR11 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR11
- .S D0=INDA S X=$G(INA("BDW1ZPR11",INI(1),INI(2)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZPR11")=X K DXS,D0
- .;SET ZPR12 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR12
- .S D0=INDA S X=$G(INA("BDW1ZPR12",INI(1),INI(2)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZPR12")=X K DXS,D0
- .D:'INVS MC^INHS
- .K LINE S LINE="",CP=0 S L1="ZPR" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZPR1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZPR2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZPR3"))
- .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ZPR4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- .S L1=$G(@INV@("ZPR5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("ZPR6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- .S L1=$G(@INV@("ZPR7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP) S L1=$G(@INV@("ZPR8")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
- .S L1=$G(@INV@("ZPR9")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP) S L1=$G(@INV@("ZPR10")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- .S L1=$G(@INV@("ZPR11")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP) S L1=$G(@INV@("ZPR12")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- .D SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
- .S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- .Q
- S INDA=INDA1 K INDA1
- Q
- D1 S INDA=INDA0 K INDA0
- SET INSETID=0
- ;SET ZPN1 = INSGX\^INTHL7FT(1,3)\\999\"1"
- S D0=INDA S X="1"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZPN1")=X K DXS,D0
- ;SET ZPN2 = INSGX\^INTHL7F(16476,5)\\999\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16476,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZPN2")=X K DXS,D0
- ;SET ZPN3 = INSGX\^INTHL7F(16477,5)\\999\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16477,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZPN3")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="ZPN" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZPN1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZPN2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZPN3"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA("ZDN",INI(1))) Q:'INI(1) S INDA=$S(INDA("ZDN",INI(1)):INDA("ZDN",INI(1)),1:INI(1)) D
- .;SET ZDN1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN1
- .S D0=INDA S X=$G(INA("BDW1ZDN1",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN1")=X K DXS,D0
- .;SET ZDN2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN2
- .S D0=INDA S X=$G(INA("BDW1ZDN2",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN2")=X K DXS,D0
- .;SET ZDN3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN3
- .S D0=INDA S X=$G(INA("BDW1ZDN3",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN3")=X K DXS,D0
- .;SET ZDN4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN4
- .S D0=INDA S X=$G(INA("BDW1ZDN4",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN4")=X K DXS,D0
- .;SET ZDN5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN5
- .S D0=INDA S X=$G(INA("BDW1ZDN5",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN5")=X K DXS,D0
- .;SET ZDN6 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN6
- .S D0=INDA S X=$G(INA("BDW1ZDN6",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN6")=X K DXS,D0
- .;SET ZDN7 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN7
- .S D0=INDA S X=$G(INA("BDW1ZDN7",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("ZDN7")=X K DXS,D0
- .D:'INVS MC^INHS
- .K LINE S LINE="",CP=0 S L1="ZDN" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZDN1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZDN2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZDN3"))
- .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ZDN4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- .S L1=$G(@INV@("ZDN5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("ZDN6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- .S L1=$G(@INV@("ZDN7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- .S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- .Q
- S INDA=INDA0 K INDA0
- SET INSETID=0
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA("ZDP",INI(1))) Q:'INI(1) S INDA=$S(INDA("ZDP",INI(1)):INDA("ZDP",INI(1)),1:INI(1)) D
- .;SET ZDP1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDP1
- .S D0=INDA S X=$G(INA("BDW1ZDP1",INI(1)))
- 9 .D EN^IS00007I
- G F1^IS00007I
- IS00007H ;Compiled from script 'Generated: HL IHS DW1 A08-O' on SEP 08, 2008
- +1 ;Part 9
- +2 ;Copyright 2008 SAIC
- EN IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
- SET L1=$GET(@INV@("PR115"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
- +1 SET L1=$GET(@INV@("PR116"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
- SET L1=$GET(@INV@("PR117"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +2 DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- SET L1=$GET(@INV@("PR118"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,19,L1,.CP)
- +3 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +4 SET INSETID=0
- +5 SET INDA1=INDA
- SET INI(2)=0
- FOR
- SET INI(2)=$ORDER(INDA("ZPR",INI(2)))
- IF 'INI(2)
- QUIT
- SET INDA=$SELECT(INDA("ZPR",INI(2)):INDA("ZPR",INI(2)),1:INI(2))
- Begin DoDot:1
- +6 ;SET ZPR1 = ""
- +7 SET D0=INDA
- SET X=""
- +8 SET @INV@("ZPR1")=X
- KILL DXS,D0
- +9 ;SET ZPR2 = ""
- +10 SET D0=INDA
- SET X=""
- +11 SET @INV@("ZPR2")=X
- KILL DXS,D0
- +12 ;SET ZPR3 = ""
- +13 SET D0=INDA
- SET X=""
- +14 SET @INV@("ZPR3")=X
- KILL DXS,D0
- +15 ;SET ZPR4 = ""
- +16 SET D0=INDA
- SET X=""
- +17 SET @INV@("ZPR4")=X
- KILL DXS,D0
- +18 ;SET ZPR5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR5
- +19 SET D0=INDA
- SET X=$GET(INA("BDW1ZPR5",INI(1),INI(2)))
- +20 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +21 SET @INV@("ZPR5")=X
- KILL DXS,D0
- +22 ;SET ZPR6 = ""
- +23 SET D0=INDA
- SET X=""
- +24 SET @INV@("ZPR6")=X
- KILL DXS,D0
- +25 ;SET ZPR7 = ""
- +26 SET D0=INDA
- SET X=""
- +27 SET @INV@("ZPR7")=X
- KILL DXS,D0
- +28 ;SET ZPR8 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR8
- +29 SET D0=INDA
- SET X=$GET(INA("BDW1ZPR8",INI(1),INI(2)))
- +30 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +31 SET @INV@("ZPR8")=X
- KILL DXS,D0
- +32 ;SET ZPR9 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR9
- +33 SET D0=INDA
- SET X=$GET(INA("BDW1ZPR9",INI(1),INI(2)))
- +34 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +35 SET @INV@("ZPR9")=X
- KILL DXS,D0
- +36 ;SET ZPR10 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR10
- +37 SET D0=INDA
- SET X=$GET(INA("BDW1ZPR10",INI(1),INI(2)))
- +38 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +39 SET @INV@("ZPR10")=X
- KILL DXS,D0
- +40 ;SET ZPR11 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR11
- +41 SET D0=INDA
- SET X=$GET(INA("BDW1ZPR11",INI(1),INI(2)))
- +42 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +43 SET @INV@("ZPR11")=X
- KILL DXS,D0
- +44 ;SET ZPR12 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZPR12
- +45 SET D0=INDA
- SET X=$GET(INA("BDW1ZPR12",INI(1),INI(2)))
- +46 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +47 SET @INV@("ZPR12")=X
- KILL DXS,D0
- +48 IF 'INVS
- DO MC^INHS
- +49 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ZPR"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ZPR1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +50 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ZPR2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ZPR3"))
- +51 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("ZPR4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- +52 SET L1=$GET(@INV@("ZPR5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- SET L1=$GET(@INV@("ZPR6"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- +53 SET L1=$GET(@INV@("ZPR7"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- SET L1=$GET(@INV@("ZPR8"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
- +54 SET L1=$GET(@INV@("ZPR9"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- SET L1=$GET(@INV@("ZPR10"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- +55 SET L1=$GET(@INV@("ZPR11"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
- SET L1=$GET(@INV@("ZPR12"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +56 DO SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
- +57 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +58 QUIT
- End DoDot:1
- +59 SET INDA=INDA1
- KILL INDA1
- +60 QUIT
- D1 SET INDA=INDA0
- KILL INDA0
- +1 SET INSETID=0
- +2 ;SET ZPN1 = INSGX\^INTHL7FT(1,3)\\999\"1"
- +3 SET D0=INDA
- SET X="1"
- +4 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +5 SET @INV@("ZPN1")=X
- KILL DXS,D0
- +6 ;SET ZPN2 = INSGX\^INTHL7F(16476,5)\\999\"OUTPUT TRANSFORM"
- +7 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +8 SET X1="^INTHL7F(16476,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +9 SET @INV@("ZPN2")=X
- KILL DXS,D0
- +10 ;SET ZPN3 = INSGX\^INTHL7F(16477,5)\\999\"OUTPUT TRANSFORM"
- +11 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +12 SET X1="^INTHL7F(16477,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +13 SET @INV@("ZPN3")=X
- KILL DXS,D0
- +14 IF 'INVS
- DO MC^INHS
- +15 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ZPN"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ZPN1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +16 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ZPN2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ZPN3"))
- +17 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- +18 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +19 SET INSETID=0
- +20 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA("ZDN",INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA("ZDN",INI(1)):INDA("ZDN",INI(1)),1:INI(1))
- Begin DoDot:1
- +21 ;SET ZDN1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN1
- +22 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN1",INI(1)))
- +23 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +24 SET @INV@("ZDN1")=X
- KILL DXS,D0
- +25 ;SET ZDN2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN2
- +26 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN2",INI(1)))
- +27 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +28 SET @INV@("ZDN2")=X
- KILL DXS,D0
- +29 ;SET ZDN3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN3
- +30 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN3",INI(1)))
- +31 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +32 SET @INV@("ZDN3")=X
- KILL DXS,D0
- +33 ;SET ZDN4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN4
- +34 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN4",INI(1)))
- +35 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +36 SET @INV@("ZDN4")=X
- KILL DXS,D0
- +37 ;SET ZDN5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN5
- +38 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN5",INI(1)))
- +39 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +40 SET @INV@("ZDN5")=X
- KILL DXS,D0
- +41 ;SET ZDN6 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN6
- +42 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN6",INI(1)))
- +43 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +44 SET @INV@("ZDN6")=X
- KILL DXS,D0
- +45 ;SET ZDN7 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDN7
- +46 SET D0=INDA
- SET X=$GET(INA("BDW1ZDN7",INI(1)))
- +47 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +48 SET @INV@("ZDN7")=X
- KILL DXS,D0
- +49 IF 'INVS
- DO MC^INHS
- +50 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ZDN"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ZDN1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +51 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ZDN2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ZDN3"))
- +52 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("ZDN4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- +53 SET L1=$GET(@INV@("ZDN5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- SET L1=$GET(@INV@("ZDN6"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- +54 SET L1=$GET(@INV@("ZDN7"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- +55 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +56 QUIT
- End DoDot:1
- +57 SET INDA=INDA0
- KILL INDA0
- +58 SET INSETID=0
- +59 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA("ZDP",INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA("ZDP",INI(1)):INDA("ZDP",INI(1)),1:INI(1))
- Begin DoDot:1
- +60 ;SET ZDP1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDP1
- +61 SET D0=INDA
- SET X=$GET(INA("BDW1ZDP1",INI(1)))
- 9 DO EN^IS00007I
- End DoDot:1
- +1 GOTO F1^IS00007I
