IS00001B ;Compiled from script 'Generated: HL IHS JVN O01 PACS-O' on DEC 03, 2002
;Part 3
;Copyright 2002 SAIC
EN S L1=$G(@INV@("PID8")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP) S L1=$G(@INV@("PID11.1"))
S D0=INDA S X="" S L1=L1_X
S L1=L1_$G(@INV@("PID11.2"))
S D0=INDA S X="" S L1=L1_X
S L1=L1_$G(@INV@("PID11.3"))
S D0=INDA S X="" S L1=L1_X
S L1=L1_$G(@INV@("PID11.4"))
S D0=INDA S X="" S L1=L1_X
S L1=L1_$G(@INV@("PID11.5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP) S L1=$G(@INV@("PID12")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,13,L1,.CP) S L1=$G(@INV@("PID13")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,14,L1,.CP) S L1=$G(@INV@("PID14"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,15,L1,.CP) S L1=$G(@INV@("PID17")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
S L1=$G(@INV@("PID19")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,20,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(44,INI(1))) Q:'INI(1) S INDA=$S(INDA(44,INI(1)):INDA(44,INI(1)),1:INI(1)) D
.Q:'$D(^SC(INDA,0))
.;SET PV11 = INSGX\^INTHL7F(14573,5)\\4\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(14573,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
.S @INV@("PV11")=X K DXS,D0
.;SET PV12 = INSGX\^INTHL7F(15540,5)\\1\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15540,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
.S @INV@("PV12")=X K DXS,D0
.;SET PV13 = INSGX\^INTHL7F(15544,5)\\12\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15544,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,12)
.S @INV@("PV13")=X K DXS,D0
.;SET PV18 = INSGX\^INTHL7F(15541,5)\\60\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15541,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
.S @INV@("PV18")=X K DXS,D0
.;SET PV144 = INSGX\^INTHL7F(15542,5)\\26\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15542,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
.S @INV@("PV144")=X K DXS,D0
.;SET PV145 = INSGX\^INTHL7F(15543,5)\\26\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15543,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
.S @INV@("PV145")=X K DXS,D0
.D:'INVS MC^INHS
.K LINE S LINE="",CP=0 S L1="PV1" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("PV11")) S:$TR(L1,$G(SUBDELIM))="" L1=""
.D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("PV12")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("PV13"))
.S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("PV18")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
.S L1=$G(@INV@("PV144")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,45,L1,.CP) S L1=$G(@INV@("PV145")) S:$TR(L1,$G(SUBDELIM))="" L1=""
.D SETPIECE^INHU(.LINE,DELIM,46,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 ORC1 = $E(INTERNAL("NW"),1,2)
.S D0=INDA S X="NW",X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=2,X=$E(Y(1),Y(2),X)
.S @INV@("ORC1")=X K DXS,D0
.;SET ORC2 = INSGX\^INTHL7F(15548,5)\\75\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15548,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,75)
.S @INV@("ORC2")=X K DXS,D0
.;SET ORC3 = INSGX\^INTHL7F(15549,5)\\75\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15549,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,75)
.S @INV@("ORC3")=X K DXS,D0
.;SET ORC5 = $E(INTERNAL("IP"),1,2)
.S D0=INDA S X="IP",X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=2,X=$E(Y(1),Y(2),X)
.S @INV@("ORC5")=X K DXS,D0
.;SET ORC7 = INSGX\^INTHL7F(15546,5)\\200\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15546,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,200)
.S @INV@("ORC7")=X K DXS,D0
.;SET ORC12 = INSGX\^INTHL7F(15547,5)\\80\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15547,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,80)
.S @INV@("ORC12")=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=""
9 .D EN^IS00001C
G A1^IS00001C
IS00001B ;Compiled from script 'Generated: HL IHS JVN O01 PACS-O' on DEC 03, 2002
+1 ;Part 3
+2 ;Copyright 2002 SAIC
EN SET L1=$GET(@INV@("PID8"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
SET L1=$GET(@INV@("PID11.1"))
+1 SET D0=INDA
SET X=""
SET L1=L1_X
+2 SET L1=L1_$GET(@INV@("PID11.2"))
+3 SET D0=INDA
SET X=""
SET L1=L1_X
+4 SET L1=L1_$GET(@INV@("PID11.3"))
+5 SET D0=INDA
SET X=""
SET L1=L1_X
+6 SET L1=L1_$GET(@INV@("PID11.4"))
+7 SET D0=INDA
SET X=""
SET L1=L1_X
+8 SET L1=L1_$GET(@INV@("PID11.5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
SET L1=$GET(@INV@("PID12"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+9 DO SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
SET L1=$GET(@INV@("PID13"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,14,L1,.CP)
SET L1=$GET(@INV@("PID14"))
+10 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
SET L1=$GET(@INV@("PID17"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
+11 SET L1=$GET(@INV@("PID19"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,20,L1,.CP)
+12 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+13 SET INSETID=0
+14 SET INDA0=INDA
SET INI(1)=0
FOR
SET INI(1)=$ORDER(INDA(44,INI(1)))
IF 'INI(1)
QUIT
SET INDA=$SELECT(INDA(44,INI(1)):INDA(44,INI(1)),1:INI(1))
Begin DoDot:1
+15 IF '$DATA(^SC(INDA,0))
QUIT
+16 ;SET PV11 = INSGX\^INTHL7F(14573,5)\\4\"OUTPUT TRANSFORM"
+17 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+18 SET X1="^INTHL7F(14573,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+19 SET @INV@("PV11")=X
KILL DXS,D0
+20 ;SET PV12 = INSGX\^INTHL7F(15540,5)\\1\"OUTPUT TRANSFORM"
+21 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+22 SET X1="^INTHL7F(15540,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,1)
+23 SET @INV@("PV12")=X
KILL DXS,D0
+24 ;SET PV13 = INSGX\^INTHL7F(15544,5)\\12\"OUTPUT TRANSFORM"
+25 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+26 SET X1="^INTHL7F(15544,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,12)
+27 SET @INV@("PV13")=X
KILL DXS,D0
+28 ;SET PV18 = INSGX\^INTHL7F(15541,5)\\60\"OUTPUT TRANSFORM"
+29 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+30 SET X1="^INTHL7F(15541,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+31 SET @INV@("PV18")=X
KILL DXS,D0
+32 ;SET PV144 = INSGX\^INTHL7F(15542,5)\\26\"OUTPUT TRANSFORM"
+33 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+34 SET X1="^INTHL7F(15542,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+35 SET @INV@("PV144")=X
KILL DXS,D0
+36 ;SET PV145 = INSGX\^INTHL7F(15543,5)\\26\"OUTPUT TRANSFORM"
+37 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+38 SET X1="^INTHL7F(15543,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+39 SET @INV@("PV145")=X
KILL DXS,D0
+40 IF 'INVS
DO MC^INHS
+41 KILL LINE
SET LINE=""
SET CP=0
SET L1="PV1"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("PV11"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+42 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("PV12"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("PV13"))
+43 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("PV18"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
+44 SET L1=$GET(@INV@("PV144"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,45,L1,.CP)
SET L1=$GET(@INV@("PV145"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+45 DO SETPIECE^INHU(.LINE,DELIM,46,L1,.CP)
+46 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+47 SET INSETID=0
+48 ;SET ORC1 = $E(INTERNAL("NW"),1,2)
+49 SET D0=INDA
SET X="NW"
SET X=X
SET X=X
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=2
SET X=$EXTRACT(Y(1),Y(2),X)
+50 SET @INV@("ORC1")=X
KILL DXS,D0
+51 ;SET ORC2 = INSGX\^INTHL7F(15548,5)\\75\"OUTPUT TRANSFORM"
+52 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+53 SET X1="^INTHL7F(15548,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,75)
+54 SET @INV@("ORC2")=X
KILL DXS,D0
+55 ;SET ORC3 = INSGX\^INTHL7F(15549,5)\\75\"OUTPUT TRANSFORM"
+56 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+57 SET X1="^INTHL7F(15549,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,75)
+58 SET @INV@("ORC3")=X
KILL DXS,D0
+59 ;SET ORC5 = $E(INTERNAL("IP"),1,2)
+60 SET D0=INDA
SET X="IP"
SET X=X
SET X=X
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=2
SET X=$EXTRACT(Y(1),Y(2),X)
+61 SET @INV@("ORC5")=X
KILL DXS,D0
+62 ;SET ORC7 = INSGX\^INTHL7F(15546,5)\\200\"OUTPUT TRANSFORM"
+63 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+64 SET X1="^INTHL7F(15546,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,200)
+65 SET @INV@("ORC7")=X
KILL DXS,D0
+66 ;SET ORC12 = INSGX\^INTHL7F(15547,5)\\80\"OUTPUT TRANSFORM"
+67 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+68 SET X1="^INTHL7F(15547,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,80)
+69 SET @INV@("ORC12")=X
KILL DXS,D0
+70 IF 'INVS
DO MC^INHS
+71 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=""
9 DO EN^IS00001C
End DoDot:1
+1 GOTO A1^IS00001C
