IS00001A.m

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