- IS00029H ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on SEP 05, 2011
- ;Part 9
- ;Copyright 2011 SAIC
- EN ;SET RXA7 = INSGX\^INTHL7F(16990,5)\\20\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16990,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
- S @INV@("RXA7")=X K DXS,D0
- ;SET RXA9.1 = INSGX\^INTHL7F(16739,5)\\2\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16739,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
- S @INV@("RXA9.1")=X K DXS,D0
- ;SET RXA9.2 = INSGX\^INTHL7F(16740,5)\\40\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16740,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,40)
- S @INV@("RXA9.2")=X K DXS,D0
- ;SET RXA9.3 = INSGX\^INTHL7FT(1,3)\\10\"NIP001"
- S D0=INDA S X="NIP001"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
- S @INV@("RXA9.3")=X K DXS,D0
- ;SET RXA10 = INSGX\^INTHL7F(16731,5)\\50\#1204
- S D0=INDA S Y(1)=$S($D(^AUPNVIMM(D0,12)):^(12),1:"") S X=$P($G(^VA(200,+$P(Y(1),U,4),0)),U)
- S X1="^INTHL7F(16731,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
- S @INV@("RXA10")=X K DXS,D0
- ;SET RXA11.1 = INSGX\^INTHL7FT(1,3)\\50\.03:.06
- S DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,3) S:'D0!'$D(^AUPNVSIT(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUPNVSIT(D0,0)):^(0),1:"""")"
- S D0=INDA X DXS(9.2) S Y(102)=$G(X),D0=$P(Y(101),U,6) S:'D0!'$D(^AUTTLOC(+D0,0)) D0=-1 S Y(201)=$S($D(^AUTTLOC(D0,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(201),U,1),0)),U) S D0=I(0,0)
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
- S @INV@("RXA11.1")=X K DXS,D0
- ;SET RXA11.2 = INSGX\^INTHL7FT(1,3)\\1\""
- S D0=INDA S X=""
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
- S @INV@("RXA11.2")=X K DXS,D0
- ;SET RXA11.3 = INSGX\^INTHL7FT(1,3)\\1\""
- S D0=INDA S X=""
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
- S @INV@("RXA11.3")=X K DXS,D0
- ;SET RXA11.4 = INSGX\^INTHL7FT(1,3)\\50\.03:2101
- S D0=INDA S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""),D0=$P(Y(1),U,3) S:'D0!'$D(^AUPNVSIT(+D0,0)) D0=-1 S Y(101)=$S($D(^AUPNVSIT(D0,21)):^(21),1:"") S X=$P(Y(101),U,1) S D0=I(0,0)
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
- S @INV@("RXA11.4")=X K DXS,D0
- ;SET RXA15 = INSGX\^INTHL7F(16723,5)\\20\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16723,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
- S @INV@("RXA15")=X K DXS,D0
- ;SET RXA17.1 = INSGX\^INTHL7FT(1,3)\\3\.05:.02:.02
- S DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
- S D0=INDA X DXS(9.2) S Y(102)=$G(X),D0=$P(Y(101),U,2) S:'D0!'$D(^AUTTIMAN(+D0,0)) D0=-1 S Y(201)=$S($D(^AUTTIMAN(D0,0)):^(0),1:"") S X=$P(Y(201),U,2) S D0=I(0,0)
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,3)
- S @INV@("RXA17.1")=X K DXS,D0
- ;SET RXA17.2 = INSGX\^INTHL7FT(1,3)\\50\.05:.02
- S DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
- S D0=INDA X DXS(9.2) S X=$P($G(^AUTTIMAN(+$P(Y(101),U,2),0)),U) S D0=I(0,0)
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
- S @INV@("RXA17.2")=X K DXS,D0
- ;SET RXA17.3 = INSGX\^INTHL7FT(1,3)\\3\"MVX"
- S D0=INDA S X="MVX"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,3)
- S @INV@("RXA17.3")=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.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA5.2"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA5.3")) 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.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA9.2"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA9.3")) 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.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA11.2"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA11.3"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA11.4")) 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@("RXA17.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA17.2"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("RXA17.3")) 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
- ;SET ZRA1.1 = INSGX\^INTHL7F(14766,5)\\60\#.04
- S D0=INDA S Y(2)=$C(59)_$P($G(^DD(9000010.11,.04,0)),U,3),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,4)_":",2),$C(59))
- S X1="^INTHL7F(14766,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
- S @INV@("ZRA1.1")=X K DXS,D0
- ;SET ZRA1.2 = INSGX\^INTHL7F(14768,5)\\60\#.04
- S D0=INDA S Y(2)=$C(59)_$P($G(^DD(9000010.11,.04,0)),U,3),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,4)_":",2),$C(59))
- S X1="^INTHL7F(14768,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
- S @INV@("ZRA1.2")=X K DXS,D0
- ;SET ZRA1.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
- S D0=INDA S X="99IHS"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
- S @INV@("ZRA1.3")=X K DXS,D0
- ;SET ZRA2.1 = INSGX\^INTHL7F(14769,5)\\60\#.06
- S D0=INDA S Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($G(^BIREC(+$P(Y(1),U,6),0)),U)
- S X1="^INTHL7F(14769,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
- S @INV@("ZRA2.1")=X K DXS,D0
- ;SET ZRA2.2 = INSGX\^INTHL7F(14771,5)\\60\#.06
- S D0=INDA S Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($G(^BIREC(+$P(Y(1),U,6),0)),U)
- S X1="^INTHL7F(14771,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
- S @INV@("ZRA2.2")=X K DXS,D0
- ;SET ZRA2.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
- S D0=INDA S X="99IHS"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
- S @INV@("ZRA2.3")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="ZRA" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZRA1.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("ZRA1.2"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("ZRA1.3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZRA2.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("ZRA2.2"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("ZRA2.3")) 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
- Q
- L1 S INDA=INDA0 K INDA0
- D:'INVS MC^INHS
- ;Entering END section.
- 9 G EN^IS00029I
- IS00029H ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on SEP 05, 2011
- +1 ;Part 9
- +2 ;Copyright 2011 SAIC
- EN ;SET RXA7 = INSGX\^INTHL7F(16990,5)\\20\"OUTPUT TRANSFORM"
- +1 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +2 SET X1="^INTHL7F(16990,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,20)
- +3 SET @INV@("RXA7")=X
- KILL DXS,D0
- +4 ;SET RXA9.1 = INSGX\^INTHL7F(16739,5)\\2\"OUTPUT TRANSFORM"
- +5 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +6 SET X1="^INTHL7F(16739,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,2)
- +7 SET @INV@("RXA9.1")=X
- KILL DXS,D0
- +8 ;SET RXA9.2 = INSGX\^INTHL7F(16740,5)\\40\"OUTPUT TRANSFORM"
- +9 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +10 SET X1="^INTHL7F(16740,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,40)
- +11 SET @INV@("RXA9.2")=X
- KILL DXS,D0
- +12 ;SET RXA9.3 = INSGX\^INTHL7FT(1,3)\\10\"NIP001"
- +13 SET D0=INDA
- SET X="NIP001"
- +14 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,10)
- +15 SET @INV@("RXA9.3")=X
- KILL DXS,D0
- +16 ;SET RXA10 = INSGX\^INTHL7F(16731,5)\\50\#1204
- +17 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,12)):^(12),1:"")
- SET X=$PIECE($GET(^VA(200,+$PIECE(Y(1),U,4),0)),U)
- +18 SET X1="^INTHL7F(16731,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,50)
- +19 SET @INV@("RXA10")=X
- KILL DXS,D0
- +20 ;SET RXA11.1 = INSGX\^INTHL7FT(1,3)\\50\.03:.06
- +21 SET DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,3) S:'D0!'$D(^AUPNVSIT(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUPNVSIT(D0,0)):^(0),1:"""")"
- +22 SET D0=INDA
- XECUTE DXS(9.2)
- SET Y(102)=$GET(X)
- SET D0=$PIECE(Y(101),U,6)
- IF 'D0!'$DATA(^AUTTLOC(+D0,0))
- SET D0=-1
- SET Y(201)=$SELECT($DATA(^AUTTLOC(D0,0)):^(0),1:"")
- SET X=$PIECE($GET(^DIC(4,+$PIECE(Y(201),U,1),0)),U)
- SET D0=I(0,0)
- +23 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,50)
- +24 SET @INV@("RXA11.1")=X
- KILL DXS,D0
- +25 ;SET RXA11.2 = INSGX\^INTHL7FT(1,3)\\1\""
- +26 SET D0=INDA
- SET X=""
- +27 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,1)
- +28 SET @INV@("RXA11.2")=X
- KILL DXS,D0
- +29 ;SET RXA11.3 = INSGX\^INTHL7FT(1,3)\\1\""
- +30 SET D0=INDA
- SET X=""
- +31 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,1)
- +32 SET @INV@("RXA11.3")=X
- KILL DXS,D0
- +33 ;SET RXA11.4 = INSGX\^INTHL7FT(1,3)\\50\.03:2101
- +34 SET D0=INDA
- SET I(0,0)=$GET(D0)
- SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
- SET D0=$PIECE(Y(1),U,3)
- IF 'D0!'$DATA(^AUPNVSIT(+D0,0))
- SET D0=-1
- SET Y(101)=$SELECT($DATA(^AUPNVSIT(D0,21)):^(21),1:"")
- SET X=$PIECE(Y(101),U,1)
- SET D0=I(0,0)
- +35 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,50)
- +36 SET @INV@("RXA11.4")=X
- KILL DXS,D0
- +37 ;SET RXA15 = INSGX\^INTHL7F(16723,5)\\20\"OUTPUT TRANSFORM"
- +38 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +39 SET X1="^INTHL7F(16723,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,20)
- +40 SET @INV@("RXA15")=X
- KILL DXS,D0
- +41 ;SET RXA17.1 = INSGX\^INTHL7FT(1,3)\\3\.05:.02:.02
- +42 SET DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
- +43 SET D0=INDA
- XECUTE DXS(9.2)
- SET Y(102)=$GET(X)
- SET D0=$PIECE(Y(101),U,2)
- IF 'D0!'$DATA(^AUTTIMAN(+D0,0))
- SET D0=-1
- SET Y(201)=$SELECT($DATA(^AUTTIMAN(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(201),U,2)
- SET D0=I(0,0)
- +44 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,3)
- +45 SET @INV@("RXA17.1")=X
- KILL DXS,D0
- +46 ;SET RXA17.2 = INSGX\^INTHL7FT(1,3)\\50\.05:.02
- +47 SET DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
- +48 SET D0=INDA
- XECUTE DXS(9.2)
- SET X=$PIECE($GET(^AUTTIMAN(+$PIECE(Y(101),U,2),0)),U)
- SET D0=I(0,0)
- +49 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,50)
- +50 SET @INV@("RXA17.2")=X
- KILL DXS,D0
- +51 ;SET RXA17.3 = INSGX\^INTHL7FT(1,3)\\3\"MVX"
- +52 SET D0=INDA
- SET X="MVX"
- +53 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,3)
- +54 SET @INV@("RXA17.3")=X
- KILL DXS,D0
- +55 IF 'INVS
- DO MC^INHS
- +56 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=""
- +57 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"))
- +58 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)
- +59 SET L1=$GET(@INV@("RXA5.1"))
- +60 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +61 SET L1=L1_$GET(@INV@("RXA5.2"))
- +62 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +63 SET L1=L1_$GET(@INV@("RXA5.3"))
- 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=""
- +64 DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- 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.1"))
- +65 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +66 SET L1=L1_$GET(@INV@("RXA9.2"))
- +67 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +68 SET L1=L1_$GET(@INV@("RXA9.3"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- SET L1=$GET(@INV@("RXA10"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +69 DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- SET L1=$GET(@INV@("RXA11.1"))
- +70 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +71 SET L1=L1_$GET(@INV@("RXA11.2"))
- +72 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +73 SET L1=L1_$GET(@INV@("RXA11.3"))
- +74 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +75 SET L1=L1_$GET(@INV@("RXA11.4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
- SET L1=$GET(@INV@("RXA15"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +76 DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
- SET L1=$GET(@INV@("RXA17.1"))
- +77 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +78 SET L1=L1_$GET(@INV@("RXA17.2"))
- +79 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +80 SET L1=L1_$GET(@INV@("RXA17.3"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- +81 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +82 SET INSETID=0
- +83 ;SET ZRA1.1 = INSGX\^INTHL7F(14766,5)\\60\#.04
- +84 SET D0=INDA
- SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(9000010.11,.04,0)),U,3)
- SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
- SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,4)_":",2),$CHAR(59))
- +85 SET X1="^INTHL7F(14766,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,60)
- +86 SET @INV@("ZRA1.1")=X
- KILL DXS,D0
- +87 ;SET ZRA1.2 = INSGX\^INTHL7F(14768,5)\\60\#.04
- +88 SET D0=INDA
- SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(9000010.11,.04,0)),U,3)
- SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
- SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,4)_":",2),$CHAR(59))
- +89 SET X1="^INTHL7F(14768,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,60)
- +90 SET @INV@("ZRA1.2")=X
- KILL DXS,D0
- +91 ;SET ZRA1.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
- +92 SET D0=INDA
- SET X="99IHS"
- +93 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,5)
- +94 SET @INV@("ZRA1.3")=X
- KILL DXS,D0
- +95 ;SET ZRA2.1 = INSGX\^INTHL7F(14769,5)\\60\#.06
- +96 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
- SET X=$PIECE($GET(^BIREC(+$PIECE(Y(1),U,6),0)),U)
- +97 SET X1="^INTHL7F(14769,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,60)
- +98 SET @INV@("ZRA2.1")=X
- KILL DXS,D0
- +99 ;SET ZRA2.2 = INSGX\^INTHL7F(14771,5)\\60\#.06
- +100 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
- SET X=$PIECE($GET(^BIREC(+$PIECE(Y(1),U,6),0)),U)
- +101 SET X1="^INTHL7F(14771,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,60)
- +102 SET @INV@("ZRA2.2")=X
- KILL DXS,D0
- +103 ;SET ZRA2.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
- +104 SET D0=INDA
- SET X="99IHS"
- +105 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,5)
- +106 SET @INV@("ZRA2.3")=X
- KILL DXS,D0
- +107 IF 'INVS
- DO MC^INHS
- +108 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ZRA"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ZRA1.1"))
- +109 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +110 SET L1=L1_$GET(@INV@("ZRA1.2"))
- +111 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +112 SET L1=L1_$GET(@INV@("ZRA1.3"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ZRA2.1"))
- +113 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +114 SET L1=L1_$GET(@INV@("ZRA2.2"))
- +115 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +116 SET L1=L1_$GET(@INV@("ZRA2.3"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- +117 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +118 QUIT
- L1 SET INDA=INDA0
- KILL INDA0
- +1 IF 'INVS
- DO MC^INHS
- +2 ;Entering END section.
- 9 GOTO EN^IS00029I
