Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IS00029E

IS00029E.m

Go to the documentation of this file.
IS00029E ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on FEB 28, 2013
 ;Part 6
 ;Copyright 2013 SAIC
EN S @INV@("IN113")=X K DXS,D0
 ;SET IN116 = 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@("IN116")=X K DXS,D0
 ;SET IN118 = 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@("IN118")=X K DXS,D0
 ;SET IN119.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@("IN119.1")=X K DXS,D0
 ;SET IN119.2 = ""
 S D0=INDA S X=""
 S @INV@("IN119.2")=X K DXS,D0
 ;SET IN119.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@("IN119.3")=X K DXS,D0
 ;SET IN119.4 = INSGX\^INTHL7F(14732,5)\\106\#.12
 S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($G(^DIC(5,+$P(Y(1),U,12),0)),U)
 S X1="^INTHL7F(14732,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
 S @INV@("IN119.4")=X K DXS,D0
 ;SET IN119.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@("IN119.5")=X K DXS,D0
 ;SET IN143 = #.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@("IN143")=X K DXS,D0
 ;SET IN147 = #.05
 S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P($G(^AUTTPIC(+$P(Y(1),U,5),0)),U)
 S @INV@("IN147")=X K DXS,D0
 ;SET IN149 = #.04
 S D0=INDA S Y(1)=$S($D(^AUPN3PPH(D0,0)):^(0),1:"") S X=$P(Y(1),U,4)
 S @INV@("IN149")=X K DXS,D0
 D:'INVS MC^INHS
 K LINE S LINE="",CP=0 S L1="IN1" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("IN11")) S:$TR(L1,$G(SUBDELIM))="" L1=""
 D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("IN14")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP) S L1=$G(@INV@("IN18"))
 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP) S L1=$G(@INV@("IN112")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
 S L1=$G(@INV@("IN113")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,14,L1,.CP) S L1=$G(@INV@("IN116")) S:$TR(L1,$G(SUBDELIM))="" L1=""
 D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP) S L1=$G(@INV@("IN118")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,19,L1,.CP) S L1=$G(@INV@("IN119.1"))
 S D0=INDA S X="^" S L1=L1_X
 S L1=L1_$G(@INV@("IN119.2"))
 S D0=INDA S X="^" S L1=L1_X
 S L1=L1_$G(@INV@("IN119.3"))
 S D0=INDA S X="^" S L1=L1_X
 S L1=L1_$G(@INV@("IN119.4"))
 S D0=INDA S X="^" S L1=L1_X
 S L1=L1_$G(@INV@("IN119.5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,20,L1,.CP)
 S D0=INDA S X=@INV@("IN143"),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,44,L1,.CP)
 S D0=INDA S X=@INV@("IN147"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=20,X=$E(Y(1),Y(2),X) S L1=X
 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,48,L1,.CP)
 S D0=INDA S X=@INV@("IN149"),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,50,L1,.CP)
 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
 Q
J1 S INDA=INDA0 K INDA0
 SET INSETID=0
 I '$D(INDA(9000005)) S INI=0 F  S INI=$O(^AUPNRRE("B",INDA,INI)) Q:'INI  S INDA(9000005,INI)=""
 S INDA0=INDA,INI(1)=0  F  S INI(1)=$O(INDA(9000005,INI(1))) Q:'INI(1)  S INDA=$S(INDA(9000005,INI(1)):INDA(9000005,INI(1)),1:INI(1)) D
 .Q:'$D(^AUPNRRE(INDA,0))
 .Q
 S INDA=INDA0 K INDA0
 SET INSETID=0
 I '$D(INDA(9000010.11)) S INI=0 F  S INI=$O(^AUPNVIMM("AC",INDA,INI)) Q:'INI  S INDA(9000010.11,INI)=""
 S INDA0=INDA,INI(1)=0  F  S INI(1)=$O(INDA(9000010.11,INI(1))) Q:'INI(1)  S INDA=$S(INDA(9000010.11,INI(1)):INDA(9000010.11,INI(1)),1:INI(1)) D
 .Q:'$D(^AUPNVIMM(INDA,0))
 .;SET ORC1 = INSGX\^INTHL7FT(1,3)\\2\"RE"
 .S D0=INDA S X="RE"
 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
 .S @INV@("ORC1")=X K DXS,D0
 .;SET ORC3 = INSGX\^INTHL7F(17024,5)\\22\"OUTPUT TRANSFORM"
 .S D0=INDA S X="OUTPUT TRANSFORM"
 .S X1="^INTHL7F(17024,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,22)
 .S @INV@("ORC3")=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@("ORC3")) 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
 .;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)\\3\@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,3)
 .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)\\50\@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,50)
 .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)
9 .D EN^IS00029F
 G L1^IS00029F