IS00004I.m

IS00004I ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002

 ;Part 10

 ;Copyright 2002 SAIC

EN 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\@2762210DDTP1

 S D0=INDA S X=$G(INA("2762210DDTP1"))

 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\@2762210DDTP2

 S D0=INDA S X=$G(INA("2762210DDTP2"))

 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\@2762210DDTP3

 S D0=INDA S X=$G(INA("2762210DDTP3"))

 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

 ;SET HL1 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL1

 S D0=INDA S X=$G(INA("2762000EHL1"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("HL1")=X K DXS,D0

 ;SET HL2 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL2

 S D0=INDA S X=$G(INA("2762000EHL2"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("HL2")=X K DXS,D0

 ;SET HL3 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL3

 S D0=INDA S X=$G(INA("2762000EHL3"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("HL3")=X K DXS,D0

 ;SET HL4 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL4

 S D0=INDA S X=$G(INA("2762000EHL4"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("HL4")=X K DXS,D0

 D:'INVS MC^INHS

 K LINE S LINE="",CP=0 S L1="HL" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("HL1")) S:$TR(L1,$G(SUBDELIM))="" L1=""

 D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("HL2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("HL3"))

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("HL4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,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 DMG1 = INSGX\^INTHL7FT(1,3)\\999\@2762000EDMG1

 S D0=INDA S X=$G(INA("2762000EDMG1"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("DMG1")=X K DXS,D0

 ;SET DMG2 = INSGX\^INTHL7FT(1,3)\\999\@2762000EDMG2

 S D0=INDA S X=$G(INA("2762000EDMG2"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("DMG2")=X K DXS,D0

 ;SET DMG3 = INSGX\^INTHL7FT(1,3)\\999\@2762000EDMG3

 S D0=INDA S X=$G(INA("2762000EDMG3"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("DMG3")=X K DXS,D0

 D:'INVS MC^INHS

 K LINE S LINE="",CP=0 S L1="DMG" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("DMG1")) S:$TR(L1,$G(SUBDELIM))="" L1=""

 D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("DMG2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("DMG3"))

 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

 ;SET NM11 = INSGX\^INTHL7FT(1,3)\\999\@2762100ENM11

 S D0=INDA S X=$G(INA("2762100ENM11"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("NM11")=X K DXS,D0

 ;SET NM12 = INSGX\^INTHL7FT(1,3)\\999\@2762100ENM12

 S D0=INDA S X=$G(INA("2762100ENM12"))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

9 G EN^IS00004J

IS00004I  ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002

 +1       ;Part 10

 +2       ;Copyright 2002 SAIC

EN         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=""

 +1        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)

 +2        DO LINE^INHUT11(.LINE,DELIM,LCT)

 +3        IF $LENGTH(LINE)'=0

               SET LCT=LCT+1

               SET ^UTILITY("INH",$JOB,LCT)=LINE

               IF $DATA(LINE)>9

                   MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +4        SET INSETID=0

 +5       ;SET DTP1 = INSGX\^INTHL7FT(1,3)\\999\@2762210DDTP1

 +6        SET D0=INDA

           SET X=$GET(INA("2762210DDTP1"))

 +7        SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +8        SET @INV@("DTP1")=X

           KILL DXS,D0

 +9       ;SET DTP2 = INSGX\^INTHL7FT(1,3)\\999\@2762210DDTP2

 +10       SET D0=INDA

           SET X=$GET(INA("2762210DDTP2"))

 +11       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +12       SET @INV@("DTP2")=X

           KILL DXS,D0

 +13      ;SET DTP3 = INSGX\^INTHL7FT(1,3)\\999\@2762210DDTP3

 +14       SET D0=INDA

           SET X=$GET(INA("2762210DDTP3"))

 +15       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +16       SET @INV@("DTP3")=X

           KILL DXS,D0

 +17       IF 'INVS

               DO MC^INHS

 +18       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=""

 +19       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"))

 +20       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

 +21       DO LINE^INHUT11(.LINE,DELIM,LCT)

 +22       IF $LENGTH(LINE)'=0

               SET LCT=LCT+1

               SET ^UTILITY("INH",$JOB,LCT)=LINE

               IF $DATA(LINE)>9

                   MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +23       SET INSETID=0

 +24      ;SET HL1 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL1

 +25       SET D0=INDA

           SET X=$GET(INA("2762000EHL1"))

 +26       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +27       SET @INV@("HL1")=X

           KILL DXS,D0

 +28      ;SET HL2 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL2

 +29       SET D0=INDA

           SET X=$GET(INA("2762000EHL2"))

 +30       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +31       SET @INV@("HL2")=X

           KILL DXS,D0

 +32      ;SET HL3 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL3

 +33       SET D0=INDA

           SET X=$GET(INA("2762000EHL3"))

 +34       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +35       SET @INV@("HL3")=X

           KILL DXS,D0

 +36      ;SET HL4 = INSGX\^INTHL7FT(1,3)\\999\@2762000EHL4

 +37       SET D0=INDA

           SET X=$GET(INA("2762000EHL4"))

 +38       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +39       SET @INV@("HL4")=X

           KILL DXS,D0

 +40       IF 'INVS

               DO MC^INHS

 +41       KILL LINE

           SET LINE=""

           SET CP=0

           SET L1="HL"

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)

           SET L1=$GET(@INV@("HL1"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

 +42       DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

           SET L1=$GET(@INV@("HL2"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)

           SET L1=$GET(@INV@("HL3"))

 +43       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

           SET L1=$GET(@INV@("HL4"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)

 +44       DO LINE^INHUT11(.LINE,DELIM,LCT)

 +45       IF $LENGTH(LINE)'=0

               SET LCT=LCT+1

               SET ^UTILITY("INH",$JOB,LCT)=LINE

               IF $DATA(LINE)>9

                   MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +46       SET INSETID=0

 +47      ;SET DMG1 = INSGX\^INTHL7FT(1,3)\\999\@2762000EDMG1

 +48       SET D0=INDA

           SET X=$GET(INA("2762000EDMG1"))

 +49       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +50       SET @INV@("DMG1")=X

           KILL DXS,D0

 +51      ;SET DMG2 = INSGX\^INTHL7FT(1,3)\\999\@2762000EDMG2

 +52       SET D0=INDA

           SET X=$GET(INA("2762000EDMG2"))

 +53       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +54       SET @INV@("DMG2")=X

           KILL DXS,D0

 +55      ;SET DMG3 = INSGX\^INTHL7FT(1,3)\\999\@2762000EDMG3

 +56       SET D0=INDA

           SET X=$GET(INA("2762000EDMG3"))

 +57       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +58       SET @INV@("DMG3")=X

           KILL DXS,D0

 +59       IF 'INVS

               DO MC^INHS

 +60       KILL LINE

           SET LINE=""

           SET CP=0

           SET L1="DMG"

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)

           SET L1=$GET(@INV@("DMG1"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

 +61       DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

           SET L1=$GET(@INV@("DMG2"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)

           SET L1=$GET(@INV@("DMG3"))

 +62       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

 +63       DO LINE^INHUT11(.LINE,DELIM,LCT)

 +64       IF $LENGTH(LINE)'=0

               SET LCT=LCT+1

               SET ^UTILITY("INH",$JOB,LCT)=LINE

               IF $DATA(LINE)>9

                   MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +65       SET INSETID=0

 +66      ;SET NM11 = INSGX\^INTHL7FT(1,3)\\999\@2762100ENM11

 +67       SET D0=INDA

           SET X=$GET(INA("2762100ENM11"))

 +68       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +69       SET @INV@("NM11")=X

           KILL DXS,D0

 +70      ;SET NM12 = INSGX\^INTHL7FT(1,3)\\999\@2762100ENM12

 +71       SET D0=INDA

           SET X=$GET(INA("2762100ENM12"))

 +72       SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

9          GOTO EN^IS00004J