- IS00011E ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 03, 2015
- ;Part 6
- ;Copyright 2015 SAIC
- EN S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,48)
- S @INV@("ORC3")=X K DXS,D0
- ;SET ORC5 = INSGX\^INTHL7FT(1,3)\\2\@ORC5
- S D0=INDA S X=$G(INA("ORC5",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
- S @INV@("ORC5")=X K DXS,D0
- ;SET ORC10 = @ORC10
- S D0=INDA S X=$G(INA("ORC10",INI(1)))
- S @INV@("ORC10")=X K DXS,D0
- ;SET ORC12 = @ORC12
- S D0=INDA S X=$G(INA("ORC12",INI(1)))
- S @INV@("ORC12")=X K DXS,D0
- ;SET ORC17 = INSGX\^INTHL7FT(1,3)\\250\@ORC17
- S D0=INDA S X=$G(INA("ORC17",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- S @INV@("ORC17")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="ORC" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ORC1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ORC2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ORC3"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ORC5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- S D0=INDA S X=@INV@("ORC10"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=99,X=$E(Y(1),Y(2),X) S L1=X
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- S D0=INDA S X=@INV@("ORC12"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=99,X=$E(Y(1),Y(2),X) S L1=X
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,13,L1,.CP) S L1=$G(@INV@("ORC17")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- D RXA^BYIMSEGS
- ;SET RXA1 = INSGX\^INTHL7FT(3,3)\\4\"0"
- S D0=INDA S X="0"
- S X1="^INTHL7FT(3,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
- S @INV@("RXA1")=X K DXS,D0
- ;SET RXA2 = INSGX\^INTHL7FT(3,3)\\4\@RXA2
- S D0=INDA S X=$G(INA("RXA2",INI(1)))
- S X1="^INTHL7FT(3,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
- S @INV@("RXA2")=X K DXS,D0
- ;SET RXA3 = INSGX\^INTHL7FT(1,3)\\26\@RXA3
- S D0=INDA S X=$G(INA("RXA3",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
- S @INV@("RXA3")=X K DXS,D0
- ;SET RXA4 = INSGX\^INTHL7FT(1,3)\\26\@RXA4
- S D0=INDA S X=$G(INA("RXA4",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
- S @INV@("RXA4")=X K DXS,D0
- ;SET RXA5 = INSGX\^INTHL7FT(1,3)\\250\@RXA5
- S D0=INDA S X=$G(INA("RXA5",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- S @INV@("RXA5")=X K DXS,D0
- ;SET RXA6 = INSGX\^INTHL7FT(1,3)\\99\@RXA6
- S D0=INDA S X=$G(INA("RXA6",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
- S @INV@("RXA6")=X K DXS,D0
- ;SET RXA7 = INSGX\^INTHL7FT(1,3)\\20\@RXA7
- S D0=INDA S X=$G(INA("RXA7",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
- S @INV@("RXA7")=X K DXS,D0
- ;SET RXA9 = INSGX\^INTHL7FT(1,3)\\100\@RXA9
- S D0=INDA S X=$G(INA("RXA9",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,100)
- S @INV@("RXA9")=X K DXS,D0
- ;SET RXA10 = INSGX\^INTHL7F(17035,5)\\99\@RXA10
- S D0=INDA S X=$G(INA("RXA10",INI(1)))
- S X1="^INTHL7F(17035,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
- S @INV@("RXA10")=X K DXS,D0
- ;SET RXA11 = INSGX\^INTHL7FT(1,3)\\250\@RXA11
- S D0=INDA S X=$G(INA("RXA11",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- S @INV@("RXA11")=X K DXS,D0
- ;SET RXA15 = INSGX\^INTHL7FT(1,3)\\20\@RXA15
- S D0=INDA S X=$G(INA("RXA15",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
- S @INV@("RXA15")=X K DXS,D0
- ;SET RXA16 = INSGX\^INTHL7FT(1,3)\\8\@RXA16
- S D0=INDA S X=$G(INA("RXA16",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
- S @INV@("RXA16")=X K DXS,D0
- ;SET RXA17 = INSGX\^INTHL7FT(1,3)\\250\@RXA17
- S D0=INDA S X=$G(INA("RXA17",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- S @INV@("RXA17")=X K DXS,D0
- ;SET RXA20 = INSGX\^INTHL7FT(1,3)\\10\"CP"
- S D0=INDA S X="CP"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
- S @INV@("RXA20")=X K DXS,D0
- ;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\@RXA21
- S D0=INDA S X=$G(INA("RXA21",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
- S @INV@("RXA21")=X K DXS,D0
- ;SET RXA22 = INSGX\^INTHL7FT(1,3)\\50\@RXA22
- S D0=INDA S X=$G(INA("RXA22",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
- S @INV@("RXA22")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="RXA" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("RXA1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("RXA2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("RXA3"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("RXA4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- S L1=$G(@INV@("RXA5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("RXA6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- S L1=$G(@INV@("RXA7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP) S L1=$G(@INV@("RXA9")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- S L1=$G(@INV@("RXA10")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP) S L1=$G(@INV@("RXA11")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP) S L1=$G(@INV@("RXA15")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,16,L1,.CP) S L1=$G(@INV@("RXA16"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP) S L1=$G(@INV@("RXA17")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- S L1=$G(@INV@("RXA20")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,21,L1,.CP) S L1=$G(@INV@("RXA21")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,22,L1,.CP) S L1=$G(@INV@("RXA22")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,23,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- D RXR^BYIMSEGS
- ;SET RXR1 = INSGX\^INTHL7FT(1,3)\\50\@RXR1
- S D0=INDA S X=$G(INA("RXR1",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
- S @INV@("RXR1")=X K DXS,D0
- ;SET RXR2 = INSGX\^INTHL7FT(1,3)\\250\@RXR2
- S D0=INDA S X=$G(INA("RXR2",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- S @INV@("RXR2")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="RXR" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("RXR1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("RXR2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- D OBXCE^BYIMSEG1
- ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXCE1
- S D0=INDA S X=$G(INA("OBXCE1",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
- S @INV@("OBX1")=X K DXS,D0
- ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXCE2
- S D0=INDA S X=$G(INA("OBXCE2",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
- S @INV@("OBX2")=X K DXS,D0
- 9 G EN^IS00011F
- IS00011E ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 03, 2015
- +1 ;Part 6
- +2 ;Copyright 2015 SAIC
- EN SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,48)
- +1 SET @INV@("ORC3")=X
- KILL DXS,D0
- +2 ;SET ORC5 = INSGX\^INTHL7FT(1,3)\\2\@ORC5
- +3 SET D0=INDA
- SET X=$GET(INA("ORC5",INI(1)))
- +4 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,2)
- +5 SET @INV@("ORC5")=X
- KILL DXS,D0
- +6 ;SET ORC10 = @ORC10
- +7 SET D0=INDA
- SET X=$GET(INA("ORC10",INI(1)))
- +8 SET @INV@("ORC10")=X
- KILL DXS,D0
- +9 ;SET ORC12 = @ORC12
- +10 SET D0=INDA
- SET X=$GET(INA("ORC12",INI(1)))
- +11 SET @INV@("ORC12")=X
- KILL DXS,D0
- +12 ;SET ORC17 = INSGX\^INTHL7FT(1,3)\\250\@ORC17
- +13 SET D0=INDA
- SET X=$GET(INA("ORC17",INI(1)))
- +14 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +15 SET @INV@("ORC17")=X
- KILL DXS,D0
- +16 IF 'INVS
- DO MC^INHS
- +17 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ORC"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ORC1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +18 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ORC2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ORC3"))
- +19 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("ORC5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- +20 SET D0=INDA
- SET X=@INV@("ORC10")
- SET Y(1)=$GET(X)
- SET X=1
- SET Y(2)=$GET(X)
- SET X=99
- SET X=$EXTRACT(Y(1),Y(2),X)
- SET L1=X
- +21 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- +22 SET D0=INDA
- SET X=@INV@("ORC12")
- SET Y(1)=$GET(X)
- SET X=1
- SET Y(2)=$GET(X)
- SET X=99
- SET X=$EXTRACT(Y(1),Y(2),X)
- SET L1=X
- +23 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
- SET L1=$GET(@INV@("ORC17"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- +24 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +25 SET INSETID=0
- +26 DO RXA^BYIMSEGS
- +27 ;SET RXA1 = INSGX\^INTHL7FT(3,3)\\4\"0"
- +28 SET D0=INDA
- SET X="0"
- +29 SET X1="^INTHL7FT(3,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +30 SET @INV@("RXA1")=X
- KILL DXS,D0
- +31 ;SET RXA2 = INSGX\^INTHL7FT(3,3)\\4\@RXA2
- +32 SET D0=INDA
- SET X=$GET(INA("RXA2",INI(1)))
- +33 SET X1="^INTHL7FT(3,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +34 SET @INV@("RXA2")=X
- KILL DXS,D0
- +35 ;SET RXA3 = INSGX\^INTHL7FT(1,3)\\26\@RXA3
- +36 SET D0=INDA
- SET X=$GET(INA("RXA3",INI(1)))
- +37 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,26)
- +38 SET @INV@("RXA3")=X
- KILL DXS,D0
- +39 ;SET RXA4 = INSGX\^INTHL7FT(1,3)\\26\@RXA4
- +40 SET D0=INDA
- SET X=$GET(INA("RXA4",INI(1)))
- +41 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,26)
- +42 SET @INV@("RXA4")=X
- KILL DXS,D0
- +43 ;SET RXA5 = INSGX\^INTHL7FT(1,3)\\250\@RXA5
- +44 SET D0=INDA
- SET X=$GET(INA("RXA5",INI(1)))
- +45 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +46 SET @INV@("RXA5")=X
- KILL DXS,D0
- +47 ;SET RXA6 = INSGX\^INTHL7FT(1,3)\\99\@RXA6
- +48 SET D0=INDA
- SET X=$GET(INA("RXA6",INI(1)))
- +49 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,99)
- +50 SET @INV@("RXA6")=X
- KILL DXS,D0
- +51 ;SET RXA7 = INSGX\^INTHL7FT(1,3)\\20\@RXA7
- +52 SET D0=INDA
- SET X=$GET(INA("RXA7",INI(1)))
- +53 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,20)
- +54 SET @INV@("RXA7")=X
- KILL DXS,D0
- +55 ;SET RXA9 = INSGX\^INTHL7FT(1,3)\\100\@RXA9
- +56 SET D0=INDA
- SET X=$GET(INA("RXA9",INI(1)))
- +57 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,100)
- +58 SET @INV@("RXA9")=X
- KILL DXS,D0
- +59 ;SET RXA10 = INSGX\^INTHL7F(17035,5)\\99\@RXA10
- +60 SET D0=INDA
- SET X=$GET(INA("RXA10",INI(1)))
- +61 SET X1="^INTHL7F(17035,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,99)
- +62 SET @INV@("RXA10")=X
- KILL DXS,D0
- +63 ;SET RXA11 = INSGX\^INTHL7FT(1,3)\\250\@RXA11
- +64 SET D0=INDA
- SET X=$GET(INA("RXA11",INI(1)))
- +65 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +66 SET @INV@("RXA11")=X
- KILL DXS,D0
- +67 ;SET RXA15 = INSGX\^INTHL7FT(1,3)\\20\@RXA15
- +68 SET D0=INDA
- SET X=$GET(INA("RXA15",INI(1)))
- +69 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,20)
- +70 SET @INV@("RXA15")=X
- KILL DXS,D0
- +71 ;SET RXA16 = INSGX\^INTHL7FT(1,3)\\8\@RXA16
- +72 SET D0=INDA
- SET X=$GET(INA("RXA16",INI(1)))
- +73 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,8)
- +74 SET @INV@("RXA16")=X
- KILL DXS,D0
- +75 ;SET RXA17 = INSGX\^INTHL7FT(1,3)\\250\@RXA17
- +76 SET D0=INDA
- SET X=$GET(INA("RXA17",INI(1)))
- +77 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +78 SET @INV@("RXA17")=X
- KILL DXS,D0
- +79 ;SET RXA20 = INSGX\^INTHL7FT(1,3)\\10\"CP"
- +80 SET D0=INDA
- SET X="CP"
- +81 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,10)
- +82 SET @INV@("RXA20")=X
- KILL DXS,D0
- +83 ;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\@RXA21
- +84 SET D0=INDA
- SET X=$GET(INA("RXA21",INI(1)))
- +85 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,10)
- +86 SET @INV@("RXA21")=X
- KILL DXS,D0
- +87 ;SET RXA22 = INSGX\^INTHL7FT(1,3)\\50\@RXA22
- +88 SET D0=INDA
- SET X=$GET(INA("RXA22",INI(1)))
- +89 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,50)
- +90 SET @INV@("RXA22")=X
- KILL DXS,D0
- +91 IF 'INVS
- DO MC^INHS
- +92 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="RXA"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("RXA1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +93 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("RXA2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("RXA3"))
- +94 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("RXA4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- +95 SET L1=$GET(@INV@("RXA5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- SET L1=$GET(@INV@("RXA6"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- +96 SET L1=$GET(@INV@("RXA7"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- SET L1=$GET(@INV@("RXA9"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- +97 SET L1=$GET(@INV@("RXA10"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- SET L1=$GET(@INV@("RXA11"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +98 DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
- SET L1=$GET(@INV@("RXA15"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
- SET L1=$GET(@INV@("RXA16"))
- +99 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
- SET L1=$GET(@INV@("RXA17"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- +100 SET L1=$GET(@INV@("RXA20"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,21,L1,.CP)
- SET L1=$GET(@INV@("RXA21"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +101 DO SETPIECE^INHU(.LINE,DELIM,22,L1,.CP)
- SET L1=$GET(@INV@("RXA22"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,23,L1,.CP)
- +102 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +103 SET INSETID=0
- +104 DO RXR^BYIMSEGS
- +105 ;SET RXR1 = INSGX\^INTHL7FT(1,3)\\50\@RXR1
- +106 SET D0=INDA
- SET X=$GET(INA("RXR1",INI(1)))
- +107 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,50)
- +108 SET @INV@("RXR1")=X
- KILL DXS,D0
- +109 ;SET RXR2 = INSGX\^INTHL7FT(1,3)\\250\@RXR2
- +110 SET D0=INDA
- SET X=$GET(INA("RXR2",INI(1)))
- +111 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +112 SET @INV@("RXR2")=X
- KILL DXS,D0
- +113 IF 'INVS
- DO MC^INHS
- +114 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="RXR"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("RXR1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +115 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("RXR2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- +116 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +117 SET INSETID=0
- +118 DO OBXCE^BYIMSEG1
- +119 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXCE1
- +120 SET D0=INDA
- SET X=$GET(INA("OBXCE1",INI(1)))
- +121 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,10)
- +122 SET @INV@("OBX1")=X
- KILL DXS,D0
- +123 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXCE2
- +124 SET D0=INDA
- SET X=$GET(INA("OBXCE2",INI(1)))
- +125 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,2)
- +126 SET @INV@("OBX2")=X
- KILL DXS,D0
- 9 GOTO EN^IS00011F
