IS00001A ;Compiled from script 'Generated: HL IHS JVN O01 PACS-O' on DEC 03, 2002
;Part 2
;Copyright 2002 SAIC
EN D SETPIECE^INHU(.LINE,DELIM,15,L1,.CP) S L1=$G(@INV@("MSH15")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,16,L1,.CP) S L1=$G(@INV@("MSH16"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,17,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 ^BHLPID
;SET PID1 = INSGX\^INTHL7FT(11,3)\\4\"PID"
S D0=INDA S X="PID"
S X1="^INTHL7FT(11,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
S @INV@("PID1")=X K DXS,D0
;SET PID3 = INSGX\^INTHL7FT(1,3)\\250\@PID3
S D0=INDA S X=$G(INA("PID3"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID3")=X K DXS,D0
;SET PID4 = INSGX\^INTHL7FT(1,3)\\80\@PID4
S D0=INDA S X=$G(INA("PID4"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,80)
S @INV@("PID4")=X K DXS,D0
;SET PID5 = INSGX\^INTHL7FT(7,3)\\250\#.01
S D0=INDA S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,1)
S X1="^INTHL7FT(7,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID5")=X K DXS,D0
;SET PID6 = INSGX\^INTHL7FT(7,3)\\250\#.2403
S D0=INDA S Y(1)=$S($D(^DPT(D0,.24)):^(.24),1:"") S X=$P(Y(1),U,3)
S X1="^INTHL7FT(7,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID6")=X K DXS,D0
;SET PID7 = INSGX\^INTHL7FT(4,3)\\8\DOB
S D0=INDA S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,3)
S X1="^INTHL7FT(4,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
S @INV@("PID7")=X K DXS,D0
;SET PID8 = $E(INTERNAL(SEX),1,1)
S D0=INDA S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S X=X,Y(2)=X S X=1,Y(3)=X S X=1,X=$E(Y(2),Y(3),X)
S @INV@("PID8")=X K DXS,D0
;SET PID11.1 = $E(#.111,1,106)
S D0=INDA S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,1),Y(2)=X S X=1,Y(3)=X S X=106,X=$E(Y(2),Y(3),X)
S @INV@("PID11.1")=X K DXS,D0
;SET PID11.2 = $E(#.112,1,160)
S D0=INDA S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,2),Y(2)=X S X=1,Y(3)=X S X=160,X=$E(Y(2),Y(3),X)
S @INV@("PID11.2")=X K DXS,D0
;SET PID11.3 = $E(#.114,1,106)
S D0=INDA S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,4),Y(2)=X S X=1,Y(3)=X S X=106,X=$E(Y(2),Y(3),X)
S @INV@("PID11.3")=X K DXS,D0
;SET PID11.4 = INSGX\^INTHL7F(14459,5)\\106\#.115
S D0=INDA S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$S('$D(^DIC(5,+$P(Y(1),U,5),0)):"",1:$P(^(0),U,1))
S X1="^INTHL7F(14459,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,106)
S @INV@("PID11.4")=X K DXS,D0
;SET PID11.5 = $E(#.116,1,106)
S D0=INDA S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,6),Y(2)=X S X=1,Y(3)=X S X=106,X=$E(Y(2),Y(3),X)
S @INV@("PID11.5")=X K DXS,D0
;SET PID12 = $E(INTERNAL(#.117),1,4)
S D0=INDA S Y(1)=$S($D(^DPT(D0,.11)):^(.11),1:"") S X=$P(Y(1),U,7),X=X S X=X,Y(2)=X S X=1,Y(3)=X S X=4,X=$E(Y(2),Y(3),X)
S @INV@("PID12")=X K DXS,D0
;SET PID13 = INSGX\^INTHL7FT(8,3)\\250\#.131
S D0=INDA S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,1)
S X1="^INTHL7FT(8,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID13")=X K DXS,D0
;SET PID14 = INSGX\^INTHL7FT(8,3)\\250\#.132
S D0=INDA S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,2)
S X1="^INTHL7FT(8,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID14")=X K DXS,D0
;SET PID17 = INSGX\^INTHL7FT(17,3)\\250\#.08
S D0=INDA S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$S('$D(^DIC(13,+$P(Y(1),U,8),0)):"",1:$P(^(0),U,1))
S X1="^INTHL7FT(17,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID17")=X K DXS,D0
;SET PID19 = INSGX\^INTHL7FT(1,3)\\16\#.09
S D0=INDA S Y(1)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(Y(1),U,9)
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,16)
S @INV@("PID19")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="PID" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("PID1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("PID3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("PID4"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP) S L1=$G(@INV@("PID5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
S L1=$G(@INV@("PID6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP) S L1=$G(@INV@("PID7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
9 G EN^IS00001B
IS00001A ;Compiled from script 'Generated: HL IHS JVN O01 PACS-O' on DEC 03, 2002
+1 ;Part 2
+2 ;Copyright 2002 SAIC
EN DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
SET L1=$GET(@INV@("MSH15"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
SET L1=$GET(@INV@("MSH16"))
+1 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
+2 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+3 SET INSETID=0
+4 DO ^BHLPID
+5 ;SET PID1 = INSGX\^INTHL7FT(11,3)\\4\"PID"
+6 SET D0=INDA
SET X="PID"
+7 SET X1="^INTHL7FT(11,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+8 SET @INV@("PID1")=X
KILL DXS,D0
+9 ;SET PID3 = INSGX\^INTHL7FT(1,3)\\250\@PID3
+10 SET D0=INDA
SET X=$GET(INA("PID3"))
+11 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+12 SET @INV@("PID3")=X
KILL DXS,D0
+13 ;SET PID4 = INSGX\^INTHL7FT(1,3)\\80\@PID4
+14 SET D0=INDA
SET X=$GET(INA("PID4"))
+15 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,80)
+16 SET @INV@("PID4")=X
KILL DXS,D0
+17 ;SET PID5 = INSGX\^INTHL7FT(7,3)\\250\#.01
+18 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,1)
+19 SET X1="^INTHL7FT(7,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+20 SET @INV@("PID5")=X
KILL DXS,D0
+21 ;SET PID6 = INSGX\^INTHL7FT(7,3)\\250\#.2403
+22 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.24)):^(.24),1:"")
SET X=$PIECE(Y(1),U,3)
+23 SET X1="^INTHL7FT(7,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+24 SET @INV@("PID6")=X
KILL DXS,D0
+25 ;SET PID7 = INSGX\^INTHL7FT(4,3)\\8\DOB
+26 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,3)
+27 SET X1="^INTHL7FT(4,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,8)
+28 SET @INV@("PID7")=X
KILL DXS,D0
+29 ;SET PID8 = $E(INTERNAL(SEX),1,1)
+30 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,2)
SET X=X
SET X=X
SET Y(2)=X
SET X=1
SET Y(3)=X
SET X=1
SET X=$EXTRACT(Y(2),Y(3),X)
+31 SET @INV@("PID8")=X
KILL DXS,D0
+32 ;SET PID11.1 = $E(#.111,1,106)
+33 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.11)):^(.11),1:"")
SET X=$PIECE(Y(1),U,1)
SET Y(2)=X
SET X=1
SET Y(3)=X
SET X=106
SET X=$EXTRACT(Y(2),Y(3),X)
+34 SET @INV@("PID11.1")=X
KILL DXS,D0
+35 ;SET PID11.2 = $E(#.112,1,160)
+36 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.11)):^(.11),1:"")
SET X=$PIECE(Y(1),U,2)
SET Y(2)=X
SET X=1
SET Y(3)=X
SET X=160
SET X=$EXTRACT(Y(2),Y(3),X)
+37 SET @INV@("PID11.2")=X
KILL DXS,D0
+38 ;SET PID11.3 = $E(#.114,1,106)
+39 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.11)):^(.11),1:"")
SET X=$PIECE(Y(1),U,4)
SET Y(2)=X
SET X=1
SET Y(3)=X
SET X=106
SET X=$EXTRACT(Y(2),Y(3),X)
+40 SET @INV@("PID11.3")=X
KILL DXS,D0
+41 ;SET PID11.4 = INSGX\^INTHL7F(14459,5)\\106\#.115
+42 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.11)):^(.11),1:"")
SET X=$SELECT('$DATA(^DIC(5,+$PIECE(Y(1),U,5),0)):"",1:$PIECE(^(0),U,1))
+43 SET X1="^INTHL7F(14459,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,106)
+44 SET @INV@("PID11.4")=X
KILL DXS,D0
+45 ;SET PID11.5 = $E(#.116,1,106)
+46 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.11)):^(.11),1:"")
SET X=$PIECE(Y(1),U,6)
SET Y(2)=X
SET X=1
SET Y(3)=X
SET X=106
SET X=$EXTRACT(Y(2),Y(3),X)
+47 SET @INV@("PID11.5")=X
KILL DXS,D0
+48 ;SET PID12 = $E(INTERNAL(#.117),1,4)
+49 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.11)):^(.11),1:"")
SET X=$PIECE(Y(1),U,7)
SET X=X
SET X=X
SET Y(2)=X
SET X=1
SET Y(3)=X
SET X=4
SET X=$EXTRACT(Y(2),Y(3),X)
+50 SET @INV@("PID12")=X
KILL DXS,D0
+51 ;SET PID13 = INSGX\^INTHL7FT(8,3)\\250\#.131
+52 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.13)):^(.13),1:"")
SET X=$PIECE(Y(1),U,1)
+53 SET X1="^INTHL7FT(8,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+54 SET @INV@("PID13")=X
KILL DXS,D0
+55 ;SET PID14 = INSGX\^INTHL7FT(8,3)\\250\#.132
+56 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,.13)):^(.13),1:"")
SET X=$PIECE(Y(1),U,2)
+57 SET X1="^INTHL7FT(8,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+58 SET @INV@("PID14")=X
KILL DXS,D0
+59 ;SET PID17 = INSGX\^INTHL7FT(17,3)\\250\#.08
+60 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,0)):^(0),1:"")
SET X=$SELECT('$DATA(^DIC(13,+$PIECE(Y(1),U,8),0)):"",1:$PIECE(^(0),U,1))
+61 SET X1="^INTHL7FT(17,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+62 SET @INV@("PID17")=X
KILL DXS,D0
+63 ;SET PID19 = INSGX\^INTHL7FT(1,3)\\16\#.09
+64 SET D0=INDA
SET Y(1)=$SELECT($DATA(^DPT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,9)
+65 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,16)
+66 SET @INV@("PID19")=X
KILL DXS,D0
+67 IF 'INVS
DO MC^INHS
+68 KILL LINE
SET LINE=""
SET CP=0
SET L1="PID"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("PID1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+69 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("PID3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("PID4"))
+70 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
SET L1=$GET(@INV@("PID5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
+71 SET L1=$GET(@INV@("PID6"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
SET L1=$GET(@INV@("PID7"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
9 GOTO EN^IS00001B
