IS00004L ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002
;Part 13
;Copyright 2002 SAIC
EN S @INV@("SVC4")=X K DXS,D0
;SET SVC5 = INSGX\^INTHL7FT(1,3)\\999\@2762210ESVC5
S D0=INDA S X=$G(INA("2762210ESVC5"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("SVC5")=X K DXS,D0
;SET SVC6 = INSGX\^INTHL7FT(1,3)\\999\@2762210ESVC6
S D0=INDA S X=$G(INA("2762210ESVC6"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("SVC6")=X K DXS,D0
;SET SVC7 = INSGX\^INTHL7FT(1,3)\\999\@2762210ESVC7
S D0=INDA S X=$G(INA("2762210ESVC7"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("SVC7")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="SVC" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("SVC1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("SVC2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("SVC3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("SVC4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
S L1=$G(@INV@("SVC5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("SVC6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
S L1=$G(@INV@("SVC7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
;SET REF1 = INSGX\^INTHL7FT(1,3)\\999\@2762210EREF1
S D0=INDA S X=$G(INA("2762210EREF1"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("REF1")=X K DXS,D0
;SET REF2 = INSGX\^INTHL7FT(1,3)\\999\@2762210EREF2
S D0=INDA S X=$G(INA("2762210EREF2"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("REF2")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="REF" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("REF1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("REF2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
;SET DTP1 = INSGX\^INTHL7FT(1,3)\\999\@2762210EDTP1
S D0=INDA S X=$G(INA("2762210EDTP1"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("DTP1")=X K DXS,D0
;SET DTP2 = INSGX\^INTHL7FT(1,3)\\999\@2762210EDTP2
S D0=INDA S X=$G(INA("2762210EDTP2"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("DTP2")=X K DXS,D0
;SET DTP3 = INSGX\^INTHL7FT(1,3)\\999\@2762210EDTP3
S D0=INDA S X=$G(INA("2762210EDTP3"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("DTP3")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="DTP" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("DTP1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("DTP2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("DTP3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
D SE^BHLXHDR
;SET SE1 = INSGX\^INTHL7FT(1,3)\\999\@SE01
S D0=INDA S X=$G(INA("SE01"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("SE1")=X K DXS,D0
;SET SE2 = INSGX\^INTHL7FT(1,3)\\999\@INSEQ
S D0=INDA S X=$G(INA("INSEQ"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("SE2")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="SE" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("SE1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("SE2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
D GE^BHLXHDR
;SET GE1 = @GE1
S D0=INDA S X=$G(INA("GE1"))
S @INV@("GE1")=X K DXS,D0
;SET GE2 = @GE2
9 G EN^IS00004M
IS00004L ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002
+1 ;Part 13
+2 ;Copyright 2002 SAIC
EN SET @INV@("SVC4")=X
KILL DXS,D0
+1 ;SET SVC5 = INSGX\^INTHL7FT(1,3)\\999\@2762210ESVC5
+2 SET D0=INDA
SET X=$GET(INA("2762210ESVC5"))
+3 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+4 SET @INV@("SVC5")=X
KILL DXS,D0
+5 ;SET SVC6 = INSGX\^INTHL7FT(1,3)\\999\@2762210ESVC6
+6 SET D0=INDA
SET X=$GET(INA("2762210ESVC6"))
+7 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+8 SET @INV@("SVC6")=X
KILL DXS,D0
+9 ;SET SVC7 = INSGX\^INTHL7FT(1,3)\\999\@2762210ESVC7
+10 SET D0=INDA
SET X=$GET(INA("2762210ESVC7"))
+11 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+12 SET @INV@("SVC7")=X
KILL DXS,D0
+13 IF 'INVS
DO MC^INHS
+14 KILL LINE
SET LINE=""
SET CP=0
SET L1="SVC"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("SVC1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+15 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("SVC2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("SVC3"))
+16 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("SVC4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
+17 SET L1=$GET(@INV@("SVC5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
SET L1=$GET(@INV@("SVC6"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
+18 SET L1=$GET(@INV@("SVC7"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
+19 DO LINE^INHUT11(.LINE,DELIM,LCT)
+20 IF $LENGTH(LINE)'=0
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 ;SET REF1 = INSGX\^INTHL7FT(1,3)\\999\@2762210EREF1
+23 SET D0=INDA
SET X=$GET(INA("2762210EREF1"))
+24 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+25 SET @INV@("REF1")=X
KILL DXS,D0
+26 ;SET REF2 = INSGX\^INTHL7FT(1,3)\\999\@2762210EREF2
+27 SET D0=INDA
SET X=$GET(INA("2762210EREF2"))
+28 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+29 SET @INV@("REF2")=X
KILL DXS,D0
+30 IF 'INVS
DO MC^INHS
+31 KILL LINE
SET LINE=""
SET CP=0
SET L1="REF"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("REF1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+32 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("REF2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+33 DO LINE^INHUT11(.LINE,DELIM,LCT)
+34 IF $LENGTH(LINE)'=0
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+35 SET INSETID=0
+36 ;SET DTP1 = INSGX\^INTHL7FT(1,3)\\999\@2762210EDTP1
+37 SET D0=INDA
SET X=$GET(INA("2762210EDTP1"))
+38 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+39 SET @INV@("DTP1")=X
KILL DXS,D0
+40 ;SET DTP2 = INSGX\^INTHL7FT(1,3)\\999\@2762210EDTP2
+41 SET D0=INDA
SET X=$GET(INA("2762210EDTP2"))
+42 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+43 SET @INV@("DTP2")=X
KILL DXS,D0
+44 ;SET DTP3 = INSGX\^INTHL7FT(1,3)\\999\@2762210EDTP3
+45 SET D0=INDA
SET X=$GET(INA("2762210EDTP3"))
+46 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+47 SET @INV@("DTP3")=X
KILL DXS,D0
+48 IF 'INVS
DO MC^INHS
+49 KILL LINE
SET LINE=""
SET CP=0
SET L1="DTP"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("DTP1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+50 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("DTP2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("DTP3"))
+51 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
+52 DO LINE^INHUT11(.LINE,DELIM,LCT)
+53 IF $LENGTH(LINE)'=0
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+54 SET INSETID=0
+55 DO SE^BHLXHDR
+56 ;SET SE1 = INSGX\^INTHL7FT(1,3)\\999\@SE01
+57 SET D0=INDA
SET X=$GET(INA("SE01"))
+58 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+59 SET @INV@("SE1")=X
KILL DXS,D0
+60 ;SET SE2 = INSGX\^INTHL7FT(1,3)\\999\@INSEQ
+61 SET D0=INDA
SET X=$GET(INA("INSEQ"))
+62 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+63 SET @INV@("SE2")=X
KILL DXS,D0
+64 IF 'INVS
DO MC^INHS
+65 KILL LINE
SET LINE=""
SET CP=0
SET L1="SE"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("SE1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+66 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("SE2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+67 DO LINE^INHUT11(.LINE,DELIM,LCT)
+68 IF $LENGTH(LINE)'=0
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+69 SET INSETID=0
+70 DO GE^BHLXHDR
+71 ;SET GE1 = @GE1
+72 SET D0=INDA
SET X=$GET(INA("GE1"))
+73 SET @INV@("GE1")=X
KILL DXS,D0
+74 ;SET GE2 = @GE2
9 GOTO EN^IS00004M