IS00002A ;Compiled from script 'Generated: HL IHS LOINC R01-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
;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 PID2 = INSGX\^INTHL7F(15152,5)\\250\"OUTPUT TRANSFORM"
S D0=INDA S X="OUTPUT TRANSFORM"
S X1="^INTHL7F(15152,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID2")=X K DXS,D0
;SET PID3 = INSGX\^INTHL7F(15151,5)\\250\@PID3
S D0=INDA S X=$G(INA("PID3"))
S X1="^INTHL7F(15151,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("PID3")=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@("PID2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("PID3"))
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
I '$D(INDA(9000010)) S INI=0 F S INI=$O(^AUPNVSIT("AC",INDA,INI)) Q:'INI S INDA(9000010,INI)=""
S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA(9000010,INI(1))) Q:'INI(1) S INDA=$S(INDA(9000010,INI(1)):INDA(9000010,INI(1)),1:INI(1)) D
.Q:'$D(^AUPNVSIT(INDA,0))
.;SET PV11 = INSGX\^INTHL7FT(11,3)\\4\"PV1"
.S D0=INDA S X="PV1"
.S X1="^INTHL7FT(11,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
.S @INV@("PV11")=X K DXS,D0
.;SET PV12 = INSGX\^INTHL7F(15551,5)\\1\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15551,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
.S @INV@("PV12")=X K DXS,D0
.;SET PV13 = INSGX\^INTHL7FT(1,3)\\80\@PV13LAB
.S D0=INDA S X=$G(INA("PV13LAB",INI(1)))
.S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,80)
.S @INV@("PV13")=X K DXS,D0
.;SET PV110 = INSGX\^INTHL7FT(1,3)\\2\@PV110LAB
.S D0=INDA S X=$G(INA("PV110LAB",INI(1)))
.S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
.S @INV@("PV110")=X K DXS,D0
.;SET PV119 = INSGX\^INTHL7F(15554,5)\\20\"OUTPUT TRANSFORM"
.S D0=INDA S X="OUTPUT TRANSFORM"
.S X1="^INTHL7F(15554,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
.S @INV@("PV119")=X K DXS,D0
.;SET PV144 = INSGX\^INTHL7FT(6,3)\\26\#.01
.S D0=INDA S Y(1)=$S($D(^AUPNVSIT(D0,0)):^(0),1:"") S X=$P(Y(1),U,1)
.S X1="^INTHL7FT(6,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
.S @INV@("PV144")=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@("PV110")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
.S L1=$G(@INV@("PV119")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,20,L1,.CP) S L1=$G(@INV@("PV144")) S:$TR(L1,$G(SUBDELIM))="" L1=""
.D SETPIECE^INHU(.LINE,DELIM,45,L1,.CP)
.S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
.Q
S INDA=INDA0 K INDA0
SET INSETID=0
I '$D(INDA(9000010.09)) S INI=0 F S INI=$O(^AUPNVLAB("AC",INDA,INI)) Q:'INI S INDA(9000010.09,INI)=""
S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA(9000010.09,INI(1))) Q:'INI(1) S INDA=$S(INDA(9000010.09,INI(1)):INDA(9000010.09,INI(1)),1:INI(1)) D
.Q:'$D(^AUPNVLAB(INDA,0))
.;SET OBR1 = INSGX\^INTHL7FT(11,3)\\4\"OBR"
.S D0=INDA S X="OBR"
.S X1="^INTHL7FT(11,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
.S @INV@("OBR1")=X K DXS,D0
.;SET OBR2 = INSGX\^INTHL7FT(1,3)\\20\#.06
.S D0=INDA S Y(1)=$S($D(^AUPNVLAB(D0,0)):^(0),1:"") S X=$P(Y(1),U,6)
.S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
.S @INV@("OBR2")=X K DXS,D0
.;SET OBR4 = INSGX\^INTHL7FT(1,3)\\250\@OBR4LAB
.S D0=INDA S X=$G(INA("OBR4LAB",INI(1)))
9 .D EN^IS00002B
G B1^IS00002B
IS00002A ;Compiled from script 'Generated: HL IHS LOINC R01-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 ;SET PID1 = INSGX\^INTHL7FT(11,3)\\4\"PID"
+5 SET D0=INDA
SET X="PID"
+6 SET X1="^INTHL7FT(11,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+7 SET @INV@("PID1")=X
KILL DXS,D0
+8 ;SET PID2 = INSGX\^INTHL7F(15152,5)\\250\"OUTPUT TRANSFORM"
+9 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+10 SET X1="^INTHL7F(15152,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+11 SET @INV@("PID2")=X
KILL DXS,D0
+12 ;SET PID3 = INSGX\^INTHL7F(15151,5)\\250\@PID3
+13 SET D0=INDA
SET X=$GET(INA("PID3"))
+14 SET X1="^INTHL7F(15151,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+15 SET @INV@("PID3")=X
KILL DXS,D0
+16 IF 'INVS
DO MC^INHS
+17 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=""
+18 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("PID2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("PID3"))
+19 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
+20 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+21 SET INSETID=0
+22 IF '$DATA(INDA(9000010))
SET INI=0
FOR
SET INI=$ORDER(^AUPNVSIT("AC",INDA,INI))
IF 'INI
QUIT
SET INDA(9000010,INI)=""
+23 SET INDA0=INDA
SET INI(1)=0
FOR
SET INI(1)=$ORDER(INDA(9000010,INI(1)))
IF 'INI(1)
QUIT
SET INDA=$SELECT(INDA(9000010,INI(1)):INDA(9000010,INI(1)),1:INI(1))
Begin DoDot:1
+24 IF '$DATA(^AUPNVSIT(INDA,0))
QUIT
+25 ;SET PV11 = INSGX\^INTHL7FT(11,3)\\4\"PV1"
+26 SET D0=INDA
SET X="PV1"
+27 SET X1="^INTHL7FT(11,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+28 SET @INV@("PV11")=X
KILL DXS,D0
+29 ;SET PV12 = INSGX\^INTHL7F(15551,5)\\1\"OUTPUT TRANSFORM"
+30 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+31 SET X1="^INTHL7F(15551,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,1)
+32 SET @INV@("PV12")=X
KILL DXS,D0
+33 ;SET PV13 = INSGX\^INTHL7FT(1,3)\\80\@PV13LAB
+34 SET D0=INDA
SET X=$GET(INA("PV13LAB",INI(1)))
+35 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,80)
+36 SET @INV@("PV13")=X
KILL DXS,D0
+37 ;SET PV110 = INSGX\^INTHL7FT(1,3)\\2\@PV110LAB
+38 SET D0=INDA
SET X=$GET(INA("PV110LAB",INI(1)))
+39 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+40 SET @INV@("PV110")=X
KILL DXS,D0
+41 ;SET PV119 = INSGX\^INTHL7F(15554,5)\\20\"OUTPUT TRANSFORM"
+42 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+43 SET X1="^INTHL7F(15554,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+44 SET @INV@("PV119")=X
KILL DXS,D0
+45 ;SET PV144 = INSGX\^INTHL7FT(6,3)\\26\#.01
+46 SET D0=INDA
SET Y(1)=$SELECT($DATA(^AUPNVSIT(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,1)
+47 SET X1="^INTHL7FT(6,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+48 SET @INV@("PV144")=X
KILL DXS,D0
+49 IF 'INVS
DO MC^INHS
+50 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=""
+51 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"))
+52 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("PV110"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
+53 SET L1=$GET(@INV@("PV119"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,20,L1,.CP)
SET L1=$GET(@INV@("PV144"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+54 DO SETPIECE^INHU(.LINE,DELIM,45,L1,.CP)
+55 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+56 QUIT
End DoDot:1
+57 SET INDA=INDA0
KILL INDA0
+58 SET INSETID=0
+59 IF '$DATA(INDA(9000010.09))
SET INI=0
FOR
SET INI=$ORDER(^AUPNVLAB("AC",INDA,INI))
IF 'INI
QUIT
SET INDA(9000010.09,INI)=""
+60 SET INDA0=INDA
SET INI(1)=0
FOR
SET INI(1)=$ORDER(INDA(9000010.09,INI(1)))
IF 'INI(1)
QUIT
SET INDA=$SELECT(INDA(9000010.09,INI(1)):INDA(9000010.09,INI(1)),1:INI(1))
Begin DoDot:1
+61 IF '$DATA(^AUPNVLAB(INDA,0))
QUIT
+62 ;SET OBR1 = INSGX\^INTHL7FT(11,3)\\4\"OBR"
+63 SET D0=INDA
SET X="OBR"
+64 SET X1="^INTHL7FT(11,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+65 SET @INV@("OBR1")=X
KILL DXS,D0
+66 ;SET OBR2 = INSGX\^INTHL7FT(1,3)\\20\#.06
+67 SET D0=INDA
SET Y(1)=$SELECT($DATA(^AUPNVLAB(D0,0)):^(0),1:"")
SET X=$PIECE(Y(1),U,6)
+68 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+69 SET @INV@("OBR2")=X
KILL DXS,D0
+70 ;SET OBR4 = INSGX\^INTHL7FT(1,3)\\250\@OBR4LAB
+71 SET D0=INDA
SET X=$GET(INA("OBR4LAB",INI(1)))
9 DO EN^IS00002B
End DoDot:1
+1 GOTO B1^IS00002B
