- IS00019A ;Compiled from script 'Generated: HL IHS LAB O01 RML-O' on AUG 14, 2006
- ;Part 2
- ;Copyright 2006 SAIC
- EN 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 PID18 = INSGX\^INTHL7FT(1,3)\\999\@PID20LABO
- S D0=INDA S X=$G(INA("PID20LABO",INI(1)))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("PID18")=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@("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 L1=$G(@INV@("PID5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- S L1=$G(@INV@("PID7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP) 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@("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@("PID18"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,19,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
- Q
- A1 S INDA=INDA0 K INDA0
- SET INSETID=0
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA("ORC",INI(1))) Q:'INI(1) S INDA=$S(INDA("ORC",INI(1)):INDA("ORC",INI(1)),1:INI(1)) D
- .;SET ORC1 = INSGX\^INTHL7F(16938,5)\\2\"OUTPUT TRANSFORM"
- .S D0=INDA S X="OUTPUT TRANSFORM"
- .S X1="^INTHL7F(16938,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
- .S @INV@("ORC1")=X K DXS,D0
- .;SET ORC2 = INSGX\^INTHL7FT(1,3)\\250\@ORC2LABO
- .S D0=INDA S X=$G(INA("ORC2LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- .S @INV@("ORC2")=X K DXS,D0
- .;SET ORC9 = INSGX\^INTHL7FT(6,3)\\14\@ORC11LABO
- .S D0=INDA S X=$G(INA("ORC11LABO",INI(1)))
- .S X1="^INTHL7FT(6,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,14)
- .S @INV@("ORC9")=X K DXS,D0
- .;SET ORC12 = INSGX\^INTHL7FT(1,3)\\250\@ORC12LABO
- .S D0=INDA S X=$G(INA("ORC12LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- .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=""
- .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ORC2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ORC9"))
- .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP) S L1=$G(@INV@("ORC12")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,13,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 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)\\250\@ORC2LABO
- .S D0=INDA S X=$G(INA("ORC2LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- .S @INV@("OBR2")=X K DXS,D0
- .;SET OBR4 = INSGX\^INTHL7FT(1,3)\\999\@OBR4LABOL
- .S D0=INDA S X=$G(INA("OBR4LABOL",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("OBR4")=X K DXS,D0
- .;SET OBR7 = INSGX\^INTHL7FT(6,3)\\14\@OBR7LABO
- .S D0=INDA S X=$G(INA("OBR7LABO",INI(1)))
- .S X1="^INTHL7FT(6,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,14)
- .S @INV@("OBR7")=X K DXS,D0
- .;SET OBR11 = INSGX\^INTHL7FT(1,3)\\999\@OBR13LABO
- .S D0=INDA S X=$G(INA("OBR13LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("OBR11")=X K DXS,D0
- .;SET OBR15 = INSGX\^INTHL7FT(1,3)\\999\@OBR15LABO
- .S D0=INDA S X=$G(INA("OBR15LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("OBR15")=X K DXS,D0
- .;SET OBR16 = INSGX\^INTHL7FT(1,3)\\250\@ORC12LABO
- .S D0=INDA S X=$G(INA("ORC12LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
- .S @INV@("OBR16")=X K DXS,D0
- .;SET OBR18 = INSGX\^INTHL7FT(1,3)\\999\@OBR18LC
- .S D0=INDA S X=$G(INA("OBR18LC",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("OBR18")=X K DXS,D0
- .;SET OBR22 = INSGX\^INTHL7FT(6,3)\\26\@OBR22LABO
- .S D0=INDA S X=$G(INA("OBR22LABO",INI(1)))
- .S X1="^INTHL7FT(6,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
- .S @INV@("OBR22")=X K DXS,D0
- .;SET OBR27 = INSGX\^INTHL7FT(1,3)\\1\@OBR27LABO
- .S D0=INDA S X=$G(INA("OBR27LABO",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
- .S @INV@("OBR27")=X K DXS,D0
- .D:'INVS MC^INHS
- .K LINE S LINE="",CP=0 S L1="OBR" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("OBR1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("OBR2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("OBR4"))
- .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP) S L1=$G(@INV@("OBR7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- .S L1=$G(@INV@("OBR11")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP) S L1=$G(@INV@("OBR15")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- .D SETPIECE^INHU(.LINE,DELIM,16,L1,.CP) S L1=$G(@INV@("OBR16")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP) S L1=$G(@INV@("OBR18"))
- .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,19,L1,.CP) S L1=$G(@INV@("OBR22")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,23,L1,.CP)
- .S L1=$G(@INV@("OBR27")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,28,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 INDA1=INDA,INI(2)=0 F S INI(2)=$O(INDA("OBX",INI(2))) Q:'INI(2) S INDA=$S(INDA("OBX",INI(2)):INDA("OBX",INI(2)),1:INI(2)) D
- ..;SET OBX1 = INSGX\^INTHL7FT(11,3)\\3\"OBX"
- ..S D0=INDA S X="OBX"
- ..S X1="^INTHL7FT(11,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,3)
- ..S @INV@("OBX1")=X K DXS,D0
- ..;SET OBX2 = INSGX\^INTHL7FT(1,3)\\999\@OBX2LABOL
- ..S D0=INDA S X=$G(INA("OBX2LABOL",INI(1),INI(2)))
- ..S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- ..S @INV@("OBX2")=X K DXS,D0
- ..;SET OBX3.1 = INSGX\^INTHL7FT(1,3)\\999\@OBX3LABOL1
- ..S D0=INDA S X=$G(INA("OBX3LABOL1",INI(1),INI(2)))
- ..S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- ..S @INV@("OBX3.1")=X K DXS,D0
- ..;SET OBX3.2 = INSGX\^INTHL7FT(1,3)\\999\@OBX3LABOL2
- 9 ..D EN^IS00019B
- .D B2^IS00019B
- G B1^IS00019B
- IS00019A ;Compiled from script 'Generated: HL IHS LAB O01 RML-O' on AUG 14, 2006
- +1 ;Part 2
- +2 ;Copyright 2006 SAIC
- EN SET X1="^INTHL7FT(8,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +1 SET @INV@("PID14")=X
- KILL DXS,D0
- +2 ;SET PID18 = INSGX\^INTHL7FT(1,3)\\999\@PID20LABO
- +3 SET D0=INDA
- SET X=$GET(INA("PID20LABO",INI(1)))
- +4 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +5 SET @INV@("PID18")=X
- KILL DXS,D0
- +6 ;SET PID19 = INSGX\^INTHL7FT(1,3)\\16\#.09
- +7 SET D0=INDA
- SET Y(1)=$SELECT($DATA(^DPT(D0,0)):^(0),1:"")
- SET X=$PIECE(Y(1),U,9)
- +8 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,16)
- +9 SET @INV@("PID19")=X
- KILL DXS,D0
- +10 IF 'INVS
- DO MC^INHS
- +11 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=""
- +12 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"))
- +13 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("PID5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- +14 SET L1=$GET(@INV@("PID7"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- SET L1=$GET(@INV@("PID8"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
- +15 SET L1=$GET(@INV@("PID11.1"))
- +16 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +17 SET L1=L1_$GET(@INV@("PID11.2"))
- +18 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +19 SET L1=L1_$GET(@INV@("PID11.3"))
- +20 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +21 SET L1=L1_$GET(@INV@("PID11.4"))
- +22 SET D0=INDA
- SET X="^"
- SET L1=L1_X
- +23 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@("PID13"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +24 DO SETPIECE^INHU(.LINE,DELIM,14,L1,.CP)
- SET L1=$GET(@INV@("PID14"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
- SET L1=$GET(@INV@("PID18"))
- +25 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,19,L1,.CP)
- SET L1=$GET(@INV@("PID19"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,20,L1,.CP)
- +26 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +27 QUIT
- A1 SET INDA=INDA0
- KILL INDA0
- +1 SET INSETID=0
- +2 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA("ORC",INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA("ORC",INI(1)):INDA("ORC",INI(1)),1:INI(1))
- Begin DoDot:1
- +3 ;SET ORC1 = INSGX\^INTHL7F(16938,5)\\2\"OUTPUT TRANSFORM"
- +4 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +5 SET X1="^INTHL7F(16938,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,2)
- +6 SET @INV@("ORC1")=X
- KILL DXS,D0
- +7 ;SET ORC2 = INSGX\^INTHL7FT(1,3)\\250\@ORC2LABO
- +8 SET D0=INDA
- SET X=$GET(INA("ORC2LABO",INI(1)))
- +9 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +10 SET @INV@("ORC2")=X
- KILL DXS,D0
- +11 ;SET ORC9 = INSGX\^INTHL7FT(6,3)\\14\@ORC11LABO
- +12 SET D0=INDA
- SET X=$GET(INA("ORC11LABO",INI(1)))
- +13 SET X1="^INTHL7FT(6,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,14)
- +14 SET @INV@("ORC9")=X
- KILL DXS,D0
- +15 ;SET ORC12 = INSGX\^INTHL7FT(1,3)\\250\@ORC12LABO
- +16 SET D0=INDA
- SET X=$GET(INA("ORC12LABO",INI(1)))
- +17 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +18 SET @INV@("ORC12")=X
- KILL DXS,D0
- +19 IF 'INVS
- DO MC^INHS
- +20 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=""
- +21 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ORC2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ORC9"))
- +22 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- SET L1=$GET(@INV@("ORC12"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
- +23 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +24 SET INSETID=0
- +25 ;SET OBR1 = INSGX\^INTHL7FT(11,3)\\4\"OBR"
- +26 SET D0=INDA
- SET X="OBR"
- +27 SET X1="^INTHL7FT(11,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +28 SET @INV@("OBR1")=X
- KILL DXS,D0
- +29 ;SET OBR2 = INSGX\^INTHL7FT(1,3)\\250\@ORC2LABO
- +30 SET D0=INDA
- SET X=$GET(INA("ORC2LABO",INI(1)))
- +31 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +32 SET @INV@("OBR2")=X
- KILL DXS,D0
- +33 ;SET OBR4 = INSGX\^INTHL7FT(1,3)\\999\@OBR4LABOL
- +34 SET D0=INDA
- SET X=$GET(INA("OBR4LABOL",INI(1)))
- +35 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +36 SET @INV@("OBR4")=X
- KILL DXS,D0
- +37 ;SET OBR7 = INSGX\^INTHL7FT(6,3)\\14\@OBR7LABO
- +38 SET D0=INDA
- SET X=$GET(INA("OBR7LABO",INI(1)))
- +39 SET X1="^INTHL7FT(6,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,14)
- +40 SET @INV@("OBR7")=X
- KILL DXS,D0
- +41 ;SET OBR11 = INSGX\^INTHL7FT(1,3)\\999\@OBR13LABO
- +42 SET D0=INDA
- SET X=$GET(INA("OBR13LABO",INI(1)))
- +43 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +44 SET @INV@("OBR11")=X
- KILL DXS,D0
- +45 ;SET OBR15 = INSGX\^INTHL7FT(1,3)\\999\@OBR15LABO
- +46 SET D0=INDA
- SET X=$GET(INA("OBR15LABO",INI(1)))
- +47 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +48 SET @INV@("OBR15")=X
- KILL DXS,D0
- +49 ;SET OBR16 = INSGX\^INTHL7FT(1,3)\\250\@ORC12LABO
- +50 SET D0=INDA
- SET X=$GET(INA("ORC12LABO",INI(1)))
- +51 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,250)
- +52 SET @INV@("OBR16")=X
- KILL DXS,D0
- +53 ;SET OBR18 = INSGX\^INTHL7FT(1,3)\\999\@OBR18LC
- +54 SET D0=INDA
- SET X=$GET(INA("OBR18LC",INI(1)))
- +55 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +56 SET @INV@("OBR18")=X
- KILL DXS,D0
- +57 ;SET OBR22 = INSGX\^INTHL7FT(6,3)\\26\@OBR22LABO
- +58 SET D0=INDA
- SET X=$GET(INA("OBR22LABO",INI(1)))
- +59 SET X1="^INTHL7FT(6,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,26)
- +60 SET @INV@("OBR22")=X
- KILL DXS,D0
- +61 ;SET OBR27 = INSGX\^INTHL7FT(1,3)\\1\@OBR27LABO
- +62 SET D0=INDA
- SET X=$GET(INA("OBR27LABO",INI(1)))
- +63 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,1)
- +64 SET @INV@("OBR27")=X
- KILL DXS,D0
- +65 IF 'INVS
- DO MC^INHS
- +66 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="OBR"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("OBR1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +67 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("OBR2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("OBR4"))
- +68 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- SET L1=$GET(@INV@("OBR7"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
- +69 SET L1=$GET(@INV@("OBR11"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
- SET L1=$GET(@INV@("OBR15"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +70 DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
- SET L1=$GET(@INV@("OBR16"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
- SET L1=$GET(@INV@("OBR18"))
- +71 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,19,L1,.CP)
- SET L1=$GET(@INV@("OBR22"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,23,L1,.CP)
- +72 SET L1=$GET(@INV@("OBR27"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,28,L1,.CP)
- +73 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +74 SET INSETID=0
- +75 SET INDA1=INDA
- SET INI(2)=0
- FOR
- SET INI(2)=$ORDER(INDA("OBX",INI(2)))
- IF 'INI(2)
- QUIT
- SET INDA=$SELECT(INDA("OBX",INI(2)):INDA("OBX",INI(2)),1:INI(2))
- Begin DoDot:2
- +76 ;SET OBX1 = INSGX\^INTHL7FT(11,3)\\3\"OBX"
- +77 SET D0=INDA
- SET X="OBX"
- +78 SET X1="^INTHL7FT(11,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,3)
- +79 SET @INV@("OBX1")=X
- KILL DXS,D0
- +80 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\999\@OBX2LABOL
- +81 SET D0=INDA
- SET X=$GET(INA("OBX2LABOL",INI(1),INI(2)))
- +82 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +83 SET @INV@("OBX2")=X
- KILL DXS,D0
- +84 ;SET OBX3.1 = INSGX\^INTHL7FT(1,3)\\999\@OBX3LABOL1
- +85 SET D0=INDA
- SET X=$GET(INA("OBX3LABOL1",INI(1),INI(2)))
- +86 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +87 SET @INV@("OBX3.1")=X
- KILL DXS,D0
- +88 ;SET OBX3.2 = INSGX\^INTHL7FT(1,3)\\999\@OBX3LABOL2
- 9 DO EN^IS00019B
- End DoDot:2
- +1 DO B2^IS00019B
- End DoDot:1
- +2 GOTO B1^IS00019B
