- IS00029D ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on FEB 28, 2013
- ;Part 5
- ;Copyright 2013 SAIC
- EN S @INV@("GT12")=X K DXS,D0
- ;SET GT13 = INSGX\^INTHL7FT(35,3)\\250\#.01
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,1)
- S X1="^INTHL7FT(35,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- S @INV@("GT13")=X K DXS,D0
- ;SET GT15.1 = $E(#.09,1,106)
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,9),Y(2)=$G(X) S X=1,Y(3)=$G(X) S X=106,X=$E(Y(2),Y(3),X)
- S @INV@("GT15.1")=X K DXS,D0
- ;SET GT15.3 = $E(#.11,1,106)
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,11),Y(2)=$G(X) S X=1,Y(3)=$G(X) S X=106,X=$E(Y(2),Y(3),X)
- S @INV@("GT15.3")=X K DXS,D0
- ;SET GT15.4 = INSGX\^INTHL7F(15192,5)\\106\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(15192,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
- S @INV@("GT15.4")=X K DXS,D0
- ;SET GT15.5 = $E(#.13,1,106)
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,13),Y(2)=$G(X) S X=1,Y(3)=$G(X) S X=106,X=$E(Y(2),Y(3),X)
- S @INV@("GT15.5")=X K DXS,D0
- ;SET GT16 = #.14
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,14)
- S @INV@("GT16")=X K DXS,D0
- ;SET GT18 = INSGX\^INTHL7FT(6,3)\\26\#.19
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,19)
- S X1="^INTHL7FT(6,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
- S @INV@("GT18")=X K DXS,D0
- ;SET GT19 = #.08
- S D0=INDA S Y(2)=$C(59)_$P($G(^DD(9000003.1,.08,0)),U,3),Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,8)_":",2),$C(59))
- S @INV@("GT19")=X K DXS,D0
- ;SET GT113 = INSGX\^INTHL7FT(4,3)\\8\#.17
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,17)
- S X1="^INTHL7FT(4,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
- S @INV@("GT113")=X K DXS,D0
- ;SET GT114 = INSGX\^INTHL7FT(4,3)\\8\#.18
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,18)
- S X1="^INTHL7FT(4,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
- S @INV@("GT114")=X K DXS,D0
- ;SET GT116 = INSGX\^INTHL7FT(35,3)\\130\#.16
- S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($G(^AUTNEMPL(+$P(Y(1),U,16),0)),U)
- S X1="^INTHL7FT(35,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,130)
- S @INV@("GT116")=X K DXS,D0
- ;SET GT117.1 = INSGX\^INTHL7F(15201,5)\\106\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(15201,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
- S @INV@("GT117.1")=X K DXS,D0
- ;SET GT117.3 = INSGX\^INTHL7F(15202,5)\\106\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(15202,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
- S @INV@("GT117.3")=X K DXS,D0
- ;SET GT117.4 = INSGX\^INTHL7F(15203,5)\\106\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(15203,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
- S @INV@("GT117.4")=X K DXS,D0
- ;SET GT117.5 = INSGX\^INTHL7F(15204,5)\\106\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(15204,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
- S @INV@("GT117.5")=X K DXS,D0
- ;SET GT118 = INSGX\^INTHL7F(15205,5)\\40\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(15205,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,40)
- S @INV@("GT118")=X K DXS,D0
- ;SET GT120 = #.15
- S D0=INDA S Y(2)=$C(59)_$P($G(^DD(9000003.1,.15,0)),U,3),Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,15)_":",2),$C(59))
- S @INV@("GT120")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="GT1" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("GT11")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- S D0=INDA S X=@INV@("GT12"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=250,X=$E(Y(1),Y(2),X) S L1=X
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("GT13")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- S L1=$G(@INV@("GT15.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("GT15.3"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("GT15.4"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("GT15.5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- S D0=INDA S X=@INV@("GT16"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=250,X=$E(Y(1),Y(2),X) S L1=X
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP) S L1=$G(@INV@("GT18")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
- S D0=INDA S X=@INV@("GT19"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=1,X=$E(Y(1),Y(2),X) S L1=X
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP) S L1=$G(@INV@("GT113")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,14,L1,.CP)
- S L1=$G(@INV@("GT114")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,15,L1,.CP) S L1=$G(@INV@("GT116")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP) S L1=$G(@INV@("GT117.1"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("GT117.3"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("GT117.4"))
- S D0=INDA S X="^" S L1=L1_X
- S L1=L1_$G(@INV@("GT117.5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP) S L1=$G(@INV@("GT118")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,19,L1,.CP)
- S D0=INDA S X=@INV@("GT120"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=2,X=$E(Y(1),Y(2),X) S L1=X
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,21,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- Q
- G1 S INDA=INDA0 K INDA0
- SET INSETID=0
- I '$D(INDA(9000003)) S INI=0 F S INI=$O(^AUPNMCR("B",INDA,INI)) Q:'INI S INDA(9000003,INI)=""
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA(9000003,INI(1))) Q:'INI(1) S INDA=$S(INDA(9000003,INI(1)):INDA(9000003,INI(1)),1:INI(1)) D
- .Q:'$D(^AUPNMCR(INDA,0))
- .Q
- S INDA=INDA0 K INDA0
- SET INSETID=0
- I '$D(INDA(9000004)) S INI=0 F S INI=$O(^AUPNMCD("B",INDA,INI)) Q:'INI S INDA(9000004,INI)=""
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA(9000004,INI(1))) Q:'INI(1) S INDA=$S(INDA(9000004,INI(1)):INDA(9000004,INI(1)),1:INI(1)) D
- .Q:'$D(^AUPNMCD(INDA,0))
- .Q
- S INDA=INDA0 K INDA0
- SET INSETID=0
- I '$D(INDA(9000003.1)) S INI=0 F S INI=$O(^AUPN3PPH("C",INDA,INI)) Q:'INI S INDA(9000003.1,INI)=""
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA(9000003.1,INI(1))) Q:'INI(1) S INDA=$S(INDA(9000003.1,INI(1)):INDA(9000003.1,INI(1)),1:INI(1)) D
- .Q:'$D(^AUPN3PPH(INDA,0))
- .;SET IN11 = INSGX\^INTHL7FT(11,3)\\4\"IN1"
- .S D0=INDA S X="IN1"
- .S X1="^INTHL7FT(11,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
- .S @INV@("IN11")=X K DXS,D0
- .;SET IN14 = INSGX\^INTHL7FT(32,3)\\250\#.03
- .S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($G(^AUTNINS(+$P(Y(1),U,3),0)),U)
- .S X1="^INTHL7FT(32,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- .S @INV@("IN14")=X K DXS,D0
- .;SET IN18 = INSGX\^INTHL7FT(1,3)\\12\#.06
- .S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($G(^AUTNEGRP(+$P(Y(1),U,6),0)),U)
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,12)
- .S @INV@("IN18")=X K DXS,D0
- .;SET IN112 = INSGX\^INTHL7FT(4,3)\\8\#.17
- .S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,17)
- .S X1="^INTHL7FT(4,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
- .S @INV@("IN112")=X K DXS,D0
- .;SET IN113 = INSGX\^INTHL7FT(4,3)\\8\#.18
- .S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,18)
- .S X1="^INTHL7FT(4,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
- 9 .D EN^IS00029E
- G J1^IS00029E
- IS00029D ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on FEB 28, 2013
- +1 ;Part 5
- +2 ;Copyright 2013 SAIC
- EN SET @INV@("GT12")=X
- KILL DXS,D0
- +1 ;SET GT13 = INSGX\^INTHL7FT(35,3)\\250\#.01
- +2 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,1)
- +3 SET X1="^INTHL7FT(35,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +4 SET @INV@("GT13")=X
- KILL DXS,D0
- +5 ;SET GT15.1 = $E(#.09,1,106)
- +6 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,9)
- SET Y(2)=$GET(X)
- SET X=1
- SET Y(3)=$GET(X)
- SET X=106
- SET X=$EXTRACT(Y(2),Y(3),X)
- +7 SET @INV@("GT15.1")=X
- KILL DXS,D0
- +8 ;SET GT15.3 = $E(#.11,1,106)
- +9 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,11)
- SET Y(2)=$GET(X)
- SET X=1
- SET Y(3)=$GET(X)
- SET X=106
- SET X=$EXTRACT(Y(2),Y(3),X)
- +10 SET @INV@("GT15.3")=X
- KILL DXS,D0
- +11 ;SET GT15.4 = INSGX\^INTHL7F(15192,5)\\106\"OUTPUT TRANSFORM"
- +12 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +13 SET X1="^INTHL7F(15192,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,106)
- +14 SET @INV@("GT15.4")=X
- KILL DXS,D0
- +15 ;SET GT15.5 = $E(#.13,1,106)
- +16 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,13)
- SET Y(2)=$GET(X)
- SET X=1
- SET Y(3)=$GET(X)
- SET X=106
- SET X=$EXTRACT(Y(2),Y(3),X)
- +17 SET @INV@("GT15.5")=X
- KILL DXS,D0
- +18 ;SET GT16 = #.14
- +19 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,14)
- +20 SET @INV@("GT16")=X
- KILL DXS,D0
- +21 ;SET GT18 = INSGX\^INTHL7FT(6,3)\\26\#.19
- +22 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,19)
- +23 SET X1="^INTHL7FT(6,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,26)
- +24 SET @INV@("GT18")=X
- KILL DXS,D0
- +25 ;SET GT19 = #.08
- +26 SET D0=INDA
- SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(9000003.1,.08,0)),U,3)
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,8)_":",2),$CHAR(59))
- +27 SET @INV@("GT19")=X
- KILL DXS,D0
- +28 ;SET GT113 = INSGX\^INTHL7FT(4,3)\\8\#.17
- +29 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,17)
- +30 SET X1="^INTHL7FT(4,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,8)
- +31 SET @INV@("GT113")=X
- KILL DXS,D0
- +32 ;SET GT114 = INSGX\^INTHL7FT(4,3)\\8\#.18
- +33 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,18)
- +34 SET X1="^INTHL7FT(4,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,8)
- +35 SET @INV@("GT114")=X
- KILL DXS,D0
- +36 ;SET GT116 = INSGX\^INTHL7FT(35,3)\\130\#.16
- +37 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE($GET(^AUTNEMPL(+$PIECE(Y(1),U,16),0)),U)
- +38 SET X1="^INTHL7FT(35,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,130)
- +39 SET @INV@("GT116")=X
- KILL DXS,D0
- +40 ;SET GT117.1 = INSGX\^INTHL7F(15201,5)\\106\"OUTPUT TRANSFORM"
- +41 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +42 SET X1="^INTHL7F(15201,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,106)
- +43 SET @INV@("GT117.1")=X
- KILL DXS,D0
- +44 ;SET GT117.3 = INSGX\^INTHL7F(15202,5)\\106\"OUTPUT TRANSFORM"
- +45 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +46 SET X1="^INTHL7F(15202,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,106)
- +47 SET @INV@("GT117.3")=X
- KILL DXS,D0
- +48 ;SET GT117.4 = INSGX\^INTHL7F(15203,5)\\106\"OUTPUT TRANSFORM"
- +49 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +50 SET X1="^INTHL7F(15203,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,106)
- +51 SET @INV@("GT117.4")=X
- KILL DXS,D0
- +52 ;SET GT117.5 = INSGX\^INTHL7F(15204,5)\\106\"OUTPUT TRANSFORM"
- +53 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +54 SET X1="^INTHL7F(15204,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,106)
- +55 SET @INV@("GT117.5")=X
- KILL DXS,D0
- +56 ;SET GT118 = INSGX\^INTHL7F(15205,5)\\40\"OUTPUT TRANSFORM"
- +57 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +58 SET X1="^INTHL7F(15205,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,40)
- +59 SET @INV@("GT118")=X
- KILL DXS,D0
- +60 ;SET GT120 = #.15
- +61 SET D0=INDA
- SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(9000003.1,.15,0)),U,3)
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,15)_":",2),$CHAR(59))
- +62 SET @INV@("GT120")=X
- KILL DXS,D0
- +63 IF 'INVS
- DO MC^INHS
- +64 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="GT1"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("GT11"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +65 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- +66 SET D0=INDA
- SET X=@INV@("GT12")
- SET Y(1)=$GET(X)
- SET X=1
- SET Y(2)=$GET(X)
- SET X=250
- SET X=$EXTRACT(Y(1),Y(2),X)
- SET L1=X
- +67 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("GT13"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- +68 SET L1=$GET(@INV@("GT15.1"))
- +69 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +70 SET L1=L1_$GET(@INV@("GT15.3"))
- +71 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +72 SET L1=L1_$GET(@INV@("GT15.4"))
- +73 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +74 SET L1=L1_$GET(@INV@("GT15.5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- +75 SET D0=INDA
- SET X=@INV@("GT16")
- SET Y(1)=$GET(X)
- SET X=1
- SET Y(2)=$GET(X)
- SET X=250
- SET X=$EXTRACT(Y(1),Y(2),X)
- SET L1=X
- +76 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- SET L1=$GET(@INV@("GT18"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
- +77 SET D0=INDA
- SET X=@INV@("GT19")
- SET Y(1)=$GET(X)
- SET X=1
- SET Y(2)=$GET(X)
- SET X=1
- SET X=$EXTRACT(Y(1),Y(2),X)
- SET L1=X
- +78 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- SET L1=$GET(@INV@("GT113"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,14,L1,.CP)
- +79 SET L1=$GET(@INV@("GT114"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
- SET L1=$GET(@INV@("GT116"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +80 DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
- SET L1=$GET(@INV@("GT117.1"))
- +81 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +82 SET L1=L1_$GET(@INV@("GT117.3"))
- +83 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +84 SET L1=L1_$GET(@INV@("GT117.4"))
- +85 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +86 SET L1=L1_$GET(@INV@("GT117.5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
- SET L1=$GET(@INV@("GT118"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +87 DO SETPIECE^INHU(.LINE,DELIM,19,L1,.CP)
- +88 SET D0=INDA
- SET X=@INV@("GT120")
- SET Y(1)=$GET(X)
- SET X=1
- SET Y(2)=$GET(X)
- SET X=2
- SET X=$EXTRACT(Y(1),Y(2),X)
- SET L1=X
- +89 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,21,L1,.CP)
- +90 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +91 QUIT
- G1 SET INDA=INDA0
- KILL INDA0
- +1 SET INSETID=0
- +2 IF '$DATA(INDA(9000003))
- SET INI=0
- FOR
- SET INI=$ORDER(^AUPNMCR("B",INDA,INI))
- IF 'INI
- QUIT
- SET INDA(9000003,INI)=""
- +3 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA(9000003,INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA(9000003,INI(1)):INDA(9000003,INI(1)),1:INI(1))
- Begin DoDot:1
- +4 IF '$DATA(^AUPNMCR(INDA,0))
- QUIT
- +5 QUIT
- End DoDot:1
- +6 SET INDA=INDA0
- KILL INDA0
- +7 SET INSETID=0
- +8 IF '$DATA(INDA(9000004))
- SET INI=0
- FOR
- SET INI=$ORDER(^AUPNMCD("B",INDA,INI))
- IF 'INI
- QUIT
- SET INDA(9000004,INI)=""
- +9 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA(9000004,INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA(9000004,INI(1)):INDA(9000004,INI(1)),1:INI(1))
- Begin DoDot:1
- +10 IF '$DATA(^AUPNMCD(INDA,0))
- QUIT
- +11 QUIT
- End DoDot:1
- +12 SET INDA=INDA0
- KILL INDA0
- +13 SET INSETID=0
- +14 IF '$DATA(INDA(9000003.1))
- SET INI=0
- FOR
- SET INI=$ORDER(^AUPN3PPH("C",INDA,INI))
- IF 'INI
- QUIT
- SET INDA(9000003.1,INI)=""
- +15 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA(9000003.1,INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA(9000003.1,INI(1)):INDA(9000003.1,INI(1)),1:INI(1))
- Begin DoDot:1
- +16 IF '$DATA(^AUPN3PPH(INDA,0))
- QUIT
- +17 ;SET IN11 = INSGX\^INTHL7FT(11,3)\\4\"IN1"
- +18 SET D0=INDA
- SET X="IN1"
- +19 SET X1="^INTHL7FT(11,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +20 SET @INV@("IN11")=X
- KILL DXS,D0
- +21 ;SET IN14 = INSGX\^INTHL7FT(32,3)\\250\#.03
- +22 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE($GET(^AUTNINS(+$PIECE(Y(1),U,3),0)),U)
- +23 SET X1="^INTHL7FT(32,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +24 SET @INV@("IN14")=X
- KILL DXS,D0
- +25 ;SET IN18 = INSGX\^INTHL7FT(1,3)\\12\#.06
- +26 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE($GET(^AUTNEGRP(+$PIECE(Y(1),U,6),0)),U)
- +27 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,12)
- +28 SET @INV@("IN18")=X
- KILL DXS,D0
- +29 ;SET IN112 = INSGX\^INTHL7FT(4,3)\\8\#.17
- +30 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,17)
- +31 SET X1="^INTHL7FT(4,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,8)
- +32 SET @INV@("IN112")=X
- KILL DXS,D0
- +33 ;SET IN113 = INSGX\^INTHL7FT(4,3)\\8\#.18
- +34 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^AUPN3PPH(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,18)
- +35 SET X1="^INTHL7FT(4,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,8)
- 9 DO EN^IS00029E
- End DoDot:1
- +1 GOTO J1^IS00029E
