BHLX277.m

BHLX277 ; cmi/flag/maw - BHL Parse X12 277 into readable format ;  [ 10/10/2002  9:30 AM ]

 ;;3.01;BHL IHS Interfaces with GIS;**8**;OCT 15, 2002

 ;

 ;

 ;

 ;this routine will parse the incoming message into readable format

 ;

MAIN ;EP - this is the main routine driver    

 K ^BHLX277($J)

 I $G(FS)="" S FS="*"

 I $G(CS)="" S CS=":"

 D PRS

 D FL

 D UPD

 D EOJ

 Q

 ;

PRS ;-- parse the message

 S (SCNT,CNT,LCNT)=0

 S BHLXUIF=$G(UIF)

 Q:BHLXUIF=""

 S BHLXDA=0 F  S BHLXDA=$O(^INTHU(BHLXUIF,3,BHLXDA)) Q:'BHLXDA  D

 . S DATA=$G(^INTHU(BHLXUIF,3,BHLXDA,0))

 . S SEG=$P(DATA,FS)

 . Q:SEG["|"

 . I SEG="ST" S CNT=CNT+1,SCNT=0

 . I SEG="HL" S LCNT=LCNT+1

 . S SCNT=SCNT+1

 . S SEGDATA=$P($P($G(DATA),FS,2,9999),"|")

 . S ^BHLX277($J,CNT,$S(LCNT=0:1,1:LCNT),SCNT,SEG)=$G(SEGDATA)

 K SCNT,CNT,LCNT,SEG,SEGDATA,DATA

 Q

 ;

FL ;-- loop through bhlx277 and get data

 S XCNT=0

 S BHLXSDA=0 F  S BHLXSDA=$O(^BHLX277($J,BHLXSDA)) Q:'BHLXSDA  D

 . S XCNT=XCNT+1

 . S BHLXLDA=0 F  S BHLXLDA=$O(^BHLX277($J,BHLXSDA,BHLXLDA)) Q:'BHLXLDA  D

 .. S BHLXCDA=0 F  S BHLXCDA=$O(^BHLX277($J,BHLXSDA,BHLXLDA,BHLXCDA)) Q:'BHLXCDA  D

 ... S BHLXSEG=$O(^BHLX277($J,BHLXSDA,BHLXLDA,BHLXCDA,""))

 ... Q:$G(BHLXSEG)=""

 ... S BHLXDAT=$P($G(^BHLX277($J,BHLXSDA,BHLXLDA,BHLXCDA,BHLXSEG)),"~")

 ... I BHLXSEG="TRN" D TRN(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 ... I BHLXSEG="NM1" D NM1(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 ... I BHLXSEG="PER" D PER(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 ... I BHLXSEG="BHT" D BHT(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 ... I BHLXSEG="STC" D STC(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 Q

 ;

BHT(DAT,SDA,LDA,CDA) ;-- trn

 S ^BHLX277V($J,SDA,"RESP DT")=$P(DAT,FS,4)

 Q

 ;

TRN(DAT,SDA,LDA,CDA) ;-- trn

 S ^BHLX277V($J,SDA,LDA,"TRACE #")=$P(DAT,FS,2)

 Q

 ;

NM1(DAT,SDA,LDA,CDA) ;-- n1

 Q:$P(DAT,FS)'="PR"

 S ^BHLX277V($J,SDA,"PAYOR ID")=$P(DAT,FS,9)

 Q

 ;

PER(DAT,SDA,LDA,CDA)   ;--clp

 S ^BHLX277V($J,SDA,"PAYOR CN")=$P(DAT,FS,2)

 S ^BHLX277V($J,SDA,"PAYOR CT")=$P(DAT,FS,3)

 S ^BHLX277V($J,SDA,"PAYOR CI")=$P(DAT,FS,4)

 S ^BHLX277V($J,SDA,"PAYOR CTE")=$P(DAT,FS,5)

 S ^BHLX277V($J,SDA,"PAYOR EXT")=$P(DAT,FS,6)

 S ^BHLX277V($J,SDA,"PAYOR CTE2")=$P(DAT,FS,7)

 S ^BHLX277V($J,SDA,"PAYOR EXT2")=$P(DAT,FS,8)

 Q

 ;

STC(DAT,SDA,LDA,CDA)         ;-- cas

 S ^BHLX277V($J,SDA,LDA,"CLSTC1")=$P($P(DAT,FS),CS)

 S ^BHLX277V($J,SDA,LDA,"CLST1")=$P($P(DAT,FS),CS,2)

 S ^BHLX277V($J,SDA,LDA,"EID1")=$P($P(DAT,FS),CS,3)

 S ^BHLX277V($J,SDA,LDA,"RES EFDT")=$P(DAT,FS,2)

 S ^BHLX277V($J,SDA,LDA,"PD AMT")=$P(DAT,FS,5)

 S ^BHLX277V($J,SDA,LDA,"DT PD")=$P(DAT,FS,6)

 S ^BHLX277V($J,SDA,LDA,"PAY METH")=$P(DAT,FS,7)

 S ^BHLX277V($J,SDA,LDA,"CHK DT")=$P(DAT,FS,8)

 S ^BHLX277V($J,SDA,LDA,"CHK #")=$P(DAT,FS,9)

 I $P(DAT,FS,10)]"" D

 . S ^BHLX277V($J,SDA,LDA,"CLSTC2")=$P($P(DAT,FS,10),CS)

 . S ^BHLX277V($J,SDA,LDA,"CLST2")=$P($P(DAT,FS,10),CS,2)

 . S ^BHLX277V($J,SDA,LDA,"EID2")=$P($P(DAT,FS,10),CS,3)

 I $P(DAT,FS,11)]"" D

 . S ^BHLX277V($J,SDA,LDA,"CLSTC3")=$P($P(DAT,FS,11),CS)

 . S ^BHLX277V($J,SDA,LDA,"CLST3")=$P($P(DAT,FS,11),CS,2)

 . S ^BHLX277V($J,SDA,LDA,"EID3")=$P($P(DAT,FS,11),CS,3)

 Q

 ;

UPD ;-- update the holding file

 S BHLXUSDA=0 F  S BHLXUSDA=$O(^BHLX277V($J,BHLXUSDA)) Q:'BHLXUSDA  D

 . D L1(BHLXUSDA)

 . S BHLXULDA=0 F  S BHLXULDA=$O(^BHLX277V($J,BHLXUSDA,BHLXULDA)) Q:BHLXULDA=""  D

 .. D L2(BHLXUSDA,BHLXULDA)

 . D FH(BHLXUSDA,BHLXULDA,.BHLXUPD)

 K UPD

 Q

 ;

L1(USDA) ;-- setup lev 1 vars for filing

 S BHLXUPD("PAYOR ID")=$G(^BHLX277V($J,USDA,"PAYOR ID"))

 S BHLXUPD("PAYOR CN")=$G(^BHLX277V($J,USDA,"PAYOR CN"))

 S BHLXUPD("PAYOR CT")=$G(^BHLX277V($J,USDA,"PAYOR CT"))

 S BHLXUPD("PAYOR CI")=$G(^BHLX277V($J,USDA,"PAYOR CI"))

 I $G(BHLXUPD("PAYOR CT"))="ED" D

 . S BHLXUPD("PAYOR 302")=$G(BHLXUPD("PAYOR CI"))

 I $G(BHLXUPD("PAYOR CT"))="EM" D

 . S BHLXUPD("PAYOR 303")=$G(BHLXUPD("PAYOR CI"))

 I $G(BHLXUPD("PAYOR CT"))="TE" D

 . S BHLXUPD("PAYOR 304")=$G(BHLXUPD("PAYOR CI"))

 S BHLXUPD("PAYOR CTE")=$G(^BHLX277V($J,USDA,"PAYOR CTE"))

 S BHLXUPD("PAYOR EXT")=$G(^BHLX277V($J,USDA,"PAYOR EXT"))

 I $G(BHLXUPD("PAYOR CTE"))="EX" D

 . S BHLXUPD("PAYOR 305")=$G(BHLXUPD("PAYOR EXT"))

 S BHLXUPD("PAYOR CTE2")=$G(^BHLX277V($J,USDA,"PAYOR CTE2"))

 S BHLXUPD("PAYOR EXT2")=$G(^BHLX277V($J,USDA,"PAYOR EXT2"))

 I $G(BHLXUPD("PAYOR CTE2"))="EX" D

 . S BHLXUPD("PAYOR 306")=$G(BHLXUPD("PAYOR EXT2"))

 I $G(BHLXUPD("PAYOR CTE2"))="FX" D

 . S BHLXUPD("PAYOR 307")=$G(BHLXUPD("PAYOR EXT2"))

 Q

 ;

L2(USDA,ULDA)      ;-- setup level 2 vars for filing

 Q:ULDA'?.N

 S BHLXUPD("CLSTC1")=$G(^BHLX277V($J,USDA,ULDA,"CLSTC1"))

 S BHLXUPD("CLST1")=$G(^BHLX277V($J,USDA,ULDA,"CLST1"))

 S BHLXUPD("EID1")=$G(^BHLX277V($J,USDA,ULDA,"EID1"))

 S BHLXUPD("CLSTC2")=$G(^BHLX277V($J,USDA,ULDA,"CLSTC2"))

 S BHLXUPD("CLST2")=$G(^BHLX277V($J,USDA,ULDA,"CLST2"))

 S BHLXUPD("EID2")=$G(^BHLX277V($J,USDA,ULDA,"EID2"))

 S BHLXUPD("CLSTC3")=$G(^BHLX277V($J,USDA,ULDA,"CLSTC3"))

 S BHLXUPD("CLST3")=$G(^BHLX277V($J,USDA,ULDA,"CLST3"))

 S BHLXUPD("EID3")=$G(^BHLX277V($J,USDA,ULDA,"EID3"))

 S BHLXUPD("RES EFDT")=$G(^BHLX277V($J,USDA,ULDA,"RES EFDT"))

 S BHLXUPD("PD AMT")=$G(^BHLX277V($J,USDA,ULDA,"PD AMT"))

 S BHLXUPD("DT PD")=$G(^BHLX277V($J,USDA,ULDA,"DT PD"))

 S BHLXUPD("PAY METH")=$G(^BHLX277V($J,USDA,ULDA,"PAY METH"))

 S BHLXUPD("CHK DT")=$G(^BHLX277V($J,USDA,ULDA,"CHK DT"))

 S BHLXUPD("TRACE #")=$G(^BHLX277V($J,USDA,ULDA,"TRACE #"))

 S BHLXUPD("CHK #")=$G(^BHLX277V($J,USDA,ULDA,"CHK #"))

 Q

 ;

FH(USDA,ULDA,UPD) ;-- file into holding

 ;look for entry in 90051.01

 Q:'$G(UPD("TRACE #"))

 S BHLXIEN=$O(^BARECLST("B",UPD("TRACE #"),0))

 Q:'BHLXIEN

 Q:'USDA

 Q:'ULDA

 K DD,DO

 S DIE="^BARECLST(",DA=BHLXIEN

 S DR="101///"_$G(UPD("RESP DT"))_";102///"_$G(UPD("PAYOR ID"))

 S DR=DR_";103///"_$G(UPD("RES EFDT"))

 S DR=DR_";104////"_$G(UPD("PD AMT"))

 S DR=DR_";105////"_$G(UPD("DT PD"))

 S DR=DR_";106///"_$G(UPD("PAY METH"))

 S DR=DR_";107////"_$G(UPD("CHK DT"))

 S DR=DR_";108///"_$G(UPD("CHK #"))

 S DR=DR_";201///"_$G(UPD("CLSTC1"))

 S DR=DR_";202///"_$G(UPD("CLST1"))

 S DR=DR_";203///"_$G(UPD("EID1"))

 S DR=DR_";204///"_$G(UPD("CLSTC2"))

 S DR=DR_";205///"_$G(UPD("CLST2"))

 S DR=DR_";206///"_$G(UPD("EID2"))

 S DR=DR_";207///"_$G(UPD("CLSTC3"))

 S DR=DR_";208///"_$G(UPD("CLST3"))

 S DR=DR_";209///"_$G(UPD("EID3"))

 S DR=DR_";301///"_$G(UPD("PAYOR CN"))

 S DR=DR_";302///"_$G(UPD("PAYOR 302"))

 S DR=DR_";303///"_$G(UPD("PAYOR 303"))

 S DR=DR_";304///"_$G(UPD("PAYOR 304"))

 S DR=DR_";305///"_$G(UPD("PAYOR 305"))

 S DR=DR_";306///"_$G(UPD("PAYOR 306"))

 S DR=DR_";307///"_$G(UPD("PAYOR 307"))

 N UPD

 D FILE^DICN

 S BHLXHIEN=+Y

 K DIC,DR,DA

 Q

 ;

EOJ ;-- kill vars

 K ^BHLX277($J)

 K ^BHLX277V($J)

 D EN^XBVK("BHLX")

 Q

 ;

BHLX277   ; cmi/flag/maw - BHL Parse X12 277 into readable format ;  [ 10/10/2002  9:30 AM ]

 +1       ;;3.01;BHL IHS Interfaces with GIS;**8**;OCT 15, 2002

 +2       ;

 +3       ;

 +4       ;

 +5       ;this routine will parse the incoming message into readable format

 +6       ;

MAIN      ;EP - this is the main routine driver    

 +1        KILL ^BHLX277($JOB)

 +2        IF $GET(FS)=""

               SET FS="*"

 +3        IF $GET(CS)=""

               SET CS=":"

 +4        DO PRS

 +5        DO FL

 +6        DO UPD

 +7        DO EOJ

 +8        QUIT 

 +9       ;

PRS       ;-- parse the message

 +1        SET (SCNT,CNT,LCNT)=0

 +2        SET BHLXUIF=$GET(UIF)

 +3        IF BHLXUIF=""

               QUIT 

 +4        SET BHLXDA=0

           FOR 

               SET BHLXDA=$ORDER(^INTHU(BHLXUIF,3,BHLXDA))

               IF 'BHLXDA

                   QUIT 

               Begin DoDot:1

 +5                SET DATA=$GET(^INTHU(BHLXUIF,3,BHLXDA,0))

 +6                SET SEG=$PIECE(DATA,FS)

 +7                IF SEG["|"

                       QUIT 

 +8                IF SEG="ST"

                       SET CNT=CNT+1

                       SET SCNT=0

 +9                IF SEG="HL"

                       SET LCNT=LCNT+1

 +10               SET SCNT=SCNT+1

 +11               SET SEGDATA=$PIECE($PIECE($GET(DATA),FS,2,9999),"|")

 +12               SET ^BHLX277($JOB,CNT,$SELECT(LCNT=0:1,1:LCNT),SCNT,SEG)=$GET(SEGDATA)

               End DoDot:1

 +13       KILL SCNT,CNT,LCNT,SEG,SEGDATA,DATA

 +14       QUIT 

 +15      ;

FL        ;-- loop through bhlx277 and get data

 +1        SET XCNT=0

 +2        SET BHLXSDA=0

           FOR 

               SET BHLXSDA=$ORDER(^BHLX277($JOB,BHLXSDA))

               IF 'BHLXSDA

                   QUIT 

               Begin DoDot:1

 +3                SET XCNT=XCNT+1

 +4                SET BHLXLDA=0

                   FOR 

                       SET BHLXLDA=$ORDER(^BHLX277($JOB,BHLXSDA,BHLXLDA))

                       IF 'BHLXLDA

                           QUIT 

                       Begin DoDot:2

 +5                        SET BHLXCDA=0

                           FOR 

                               SET BHLXCDA=$ORDER(^BHLX277($JOB,BHLXSDA,BHLXLDA,BHLXCDA))

                               IF 'BHLXCDA

                                   QUIT 

                               Begin DoDot:3

 +6                                SET BHLXSEG=$ORDER(^BHLX277($JOB,BHLXSDA,BHLXLDA,BHLXCDA,""))

 +7                                IF $GET(BHLXSEG)=""

                                       QUIT 

 +8                                SET BHLXDAT=$PIECE($GET(^BHLX277($JOB,BHLXSDA,BHLXLDA,BHLXCDA,BHLXSEG)),"~")

 +9                                IF BHLXSEG="TRN"

                                       DO TRN(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 +10                               IF BHLXSEG="NM1"

                                       DO NM1(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 +11                               IF BHLXSEG="PER"

                                       DO PER(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 +12                               IF BHLXSEG="BHT"

                                       DO BHT(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

 +13                               IF BHLXSEG="STC"

                                       DO STC(BHLXDAT,BHLXSDA,BHLXLDA,BHLXCDA)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

 +15      ;

BHT(DAT,SDA,LDA,CDA) ;-- trn

 +1        SET ^BHLX277V($JOB,SDA,"RESP DT")=$PIECE(DAT,FS,4)

 +2        QUIT 

 +3       ;

TRN(DAT,SDA,LDA,CDA) ;-- trn

 +1        SET ^BHLX277V($JOB,SDA,LDA,"TRACE #")=$PIECE(DAT,FS,2)

 +2        QUIT 

 +3       ;

NM1(DAT,SDA,LDA,CDA) ;-- n1

 +1        IF $PIECE(DAT,FS)'="PR"

               QUIT 

 +2        SET ^BHLX277V($JOB,SDA,"PAYOR ID")=$PIECE(DAT,FS,9)

 +3        QUIT 

 +4       ;

PER(DAT,SDA,LDA,CDA) ;--clp

 +1        SET ^BHLX277V($JOB,SDA,"PAYOR CN")=$PIECE(DAT,FS,2)

 +2        SET ^BHLX277V($JOB,SDA,"PAYOR CT")=$PIECE(DAT,FS,3)

 +3        SET ^BHLX277V($JOB,SDA,"PAYOR CI")=$PIECE(DAT,FS,4)

 +4        SET ^BHLX277V($JOB,SDA,"PAYOR CTE")=$PIECE(DAT,FS,5)

 +5        SET ^BHLX277V($JOB,SDA,"PAYOR EXT")=$PIECE(DAT,FS,6)

 +6        SET ^BHLX277V($JOB,SDA,"PAYOR CTE2")=$PIECE(DAT,FS,7)

 +7        SET ^BHLX277V($JOB,SDA,"PAYOR EXT2")=$PIECE(DAT,FS,8)

 +8        QUIT 

 +9       ;

STC(DAT,SDA,LDA,CDA) ;-- cas

 +1        SET ^BHLX277V($JOB,SDA,LDA,"CLSTC1")=$PIECE($PIECE(DAT,FS),CS)

 +2        SET ^BHLX277V($JOB,SDA,LDA,"CLST1")=$PIECE($PIECE(DAT,FS),CS,2)

 +3        SET ^BHLX277V($JOB,SDA,LDA,"EID1")=$PIECE($PIECE(DAT,FS),CS,3)

 +4        SET ^BHLX277V($JOB,SDA,LDA,"RES EFDT")=$PIECE(DAT,FS,2)

 +5        SET ^BHLX277V($JOB,SDA,LDA,"PD AMT")=$PIECE(DAT,FS,5)

 +6        SET ^BHLX277V($JOB,SDA,LDA,"DT PD")=$PIECE(DAT,FS,6)

 +7        SET ^BHLX277V($JOB,SDA,LDA,"PAY METH")=$PIECE(DAT,FS,7)

 +8        SET ^BHLX277V($JOB,SDA,LDA,"CHK DT")=$PIECE(DAT,FS,8)

 +9        SET ^BHLX277V($JOB,SDA,LDA,"CHK #")=$PIECE(DAT,FS,9)

 +10       IF $PIECE(DAT,FS,10)]""

               Begin DoDot:1

 +11               SET ^BHLX277V($JOB,SDA,LDA,"CLSTC2")=$PIECE($PIECE(DAT,FS,10),CS)

 +12               SET ^BHLX277V($JOB,SDA,LDA,"CLST2")=$PIECE($PIECE(DAT,FS,10),CS,2)

 +13               SET ^BHLX277V($JOB,SDA,LDA,"EID2")=$PIECE($PIECE(DAT,FS,10),CS,3)

               End DoDot:1

 +14       IF $PIECE(DAT,FS,11)]""

               Begin DoDot:1

 +15               SET ^BHLX277V($JOB,SDA,LDA,"CLSTC3")=$PIECE($PIECE(DAT,FS,11),CS)

 +16               SET ^BHLX277V($JOB,SDA,LDA,"CLST3")=$PIECE($PIECE(DAT,FS,11),CS,2)

 +17               SET ^BHLX277V($JOB,SDA,LDA,"EID3")=$PIECE($PIECE(DAT,FS,11),CS,3)

               End DoDot:1

 +18       QUIT 

 +19      ;

UPD       ;-- update the holding file

 +1        SET BHLXUSDA=0

           FOR 

               SET BHLXUSDA=$ORDER(^BHLX277V($JOB,BHLXUSDA))

               IF 'BHLXUSDA

                   QUIT 

               Begin DoDot:1

 +2                DO L1(BHLXUSDA)

 +3                SET BHLXULDA=0

                   FOR 

                       SET BHLXULDA=$ORDER(^BHLX277V($JOB,BHLXUSDA,BHLXULDA))

                       IF BHLXULDA=""

                           QUIT 

                       Begin DoDot:2

 +4                        DO L2(BHLXUSDA,BHLXULDA)

                       End DoDot:2

 +5                DO FH(BHLXUSDA,BHLXULDA,.BHLXUPD)

               End DoDot:1

 +6        KILL UPD

 +7        QUIT 

 +8       ;

L1(USDA)  ;-- setup lev 1 vars for filing

 +1        SET BHLXUPD("PAYOR ID")=$GET(^BHLX277V($JOB,USDA,"PAYOR ID"))

 +2        SET BHLXUPD("PAYOR CN")=$GET(^BHLX277V($JOB,USDA,"PAYOR CN"))

 +3        SET BHLXUPD("PAYOR CT")=$GET(^BHLX277V($JOB,USDA,"PAYOR CT"))

 +4        SET BHLXUPD("PAYOR CI")=$GET(^BHLX277V($JOB,USDA,"PAYOR CI"))

 +5        IF $GET(BHLXUPD("PAYOR CT"))="ED"

               Begin DoDot:1

 +6                SET BHLXUPD("PAYOR 302")=$GET(BHLXUPD("PAYOR CI"))

               End DoDot:1

 +7        IF $GET(BHLXUPD("PAYOR CT"))="EM"

               Begin DoDot:1

 +8                SET BHLXUPD("PAYOR 303")=$GET(BHLXUPD("PAYOR CI"))

               End DoDot:1

 +9        IF $GET(BHLXUPD("PAYOR CT"))="TE"

               Begin DoDot:1

 +10               SET BHLXUPD("PAYOR 304")=$GET(BHLXUPD("PAYOR CI"))

               End DoDot:1

 +11       SET BHLXUPD("PAYOR CTE")=$GET(^BHLX277V($JOB,USDA,"PAYOR CTE"))

 +12       SET BHLXUPD("PAYOR EXT")=$GET(^BHLX277V($JOB,USDA,"PAYOR EXT"))

 +13       IF $GET(BHLXUPD("PAYOR CTE"))="EX"

               Begin DoDot:1

 +14               SET BHLXUPD("PAYOR 305")=$GET(BHLXUPD("PAYOR EXT"))

               End DoDot:1

 +15       SET BHLXUPD("PAYOR CTE2")=$GET(^BHLX277V($JOB,USDA,"PAYOR CTE2"))

 +16       SET BHLXUPD("PAYOR EXT2")=$GET(^BHLX277V($JOB,USDA,"PAYOR EXT2"))

 +17       IF $GET(BHLXUPD("PAYOR CTE2"))="EX"

               Begin DoDot:1

 +18               SET BHLXUPD("PAYOR 306")=$GET(BHLXUPD("PAYOR EXT2"))

               End DoDot:1

 +19       IF $GET(BHLXUPD("PAYOR CTE2"))="FX"

               Begin DoDot:1

 +20               SET BHLXUPD("PAYOR 307")=$GET(BHLXUPD("PAYOR EXT2"))

               End DoDot:1

 +21       QUIT 

 +22      ;

L2(USDA,ULDA) ;-- setup level 2 vars for filing

 +1        IF ULDA'?.N

               QUIT 

 +2        SET BHLXUPD("CLSTC1")=$GET(^BHLX277V($JOB,USDA,ULDA,"CLSTC1"))

 +3        SET BHLXUPD("CLST1")=$GET(^BHLX277V($JOB,USDA,ULDA,"CLST1"))

 +4        SET BHLXUPD("EID1")=$GET(^BHLX277V($JOB,USDA,ULDA,"EID1"))

 +5        SET BHLXUPD("CLSTC2")=$GET(^BHLX277V($JOB,USDA,ULDA,"CLSTC2"))

 +6        SET BHLXUPD("CLST2")=$GET(^BHLX277V($JOB,USDA,ULDA,"CLST2"))

 +7        SET BHLXUPD("EID2")=$GET(^BHLX277V($JOB,USDA,ULDA,"EID2"))

 +8        SET BHLXUPD("CLSTC3")=$GET(^BHLX277V($JOB,USDA,ULDA,"CLSTC3"))

 +9        SET BHLXUPD("CLST3")=$GET(^BHLX277V($JOB,USDA,ULDA,"CLST3"))

 +10       SET BHLXUPD("EID3")=$GET(^BHLX277V($JOB,USDA,ULDA,"EID3"))

 +11       SET BHLXUPD("RES EFDT")=$GET(^BHLX277V($JOB,USDA,ULDA,"RES EFDT"))

 +12       SET BHLXUPD("PD AMT")=$GET(^BHLX277V($JOB,USDA,ULDA,"PD AMT"))

 +13       SET BHLXUPD("DT PD")=$GET(^BHLX277V($JOB,USDA,ULDA,"DT PD"))

 +14       SET BHLXUPD("PAY METH")=$GET(^BHLX277V($JOB,USDA,ULDA,"PAY METH"))

 +15       SET BHLXUPD("CHK DT")=$GET(^BHLX277V($JOB,USDA,ULDA,"CHK DT"))

 +16       SET BHLXUPD("TRACE #")=$GET(^BHLX277V($JOB,USDA,ULDA,"TRACE #"))

 +17       SET BHLXUPD("CHK #")=$GET(^BHLX277V($JOB,USDA,ULDA,"CHK #"))

 +18       QUIT 

 +19      ;

FH(USDA,ULDA,UPD) ;-- file into holding

 +1       ;look for entry in 90051.01

 +2        IF '$GET(UPD("TRACE #"))

               QUIT 

 +3        SET BHLXIEN=$ORDER(^BARECLST("B",UPD("TRACE #"),0))

 +4        IF 'BHLXIEN

               QUIT 

 +5        IF 'USDA

               QUIT 

 +6        IF 'ULDA

               QUIT 

 +7        KILL DD,DO

 +8        SET DIE="^BARECLST("

           SET DA=BHLXIEN

 +9        SET DR="101///"_$GET(UPD("RESP DT"))_";102///"_$GET(UPD("PAYOR ID"))

 +10       SET DR=DR_";103///"_$GET(UPD("RES EFDT"))

 +11       SET DR=DR_";104////"_$GET(UPD("PD AMT"))

 +12       SET DR=DR_";105////"_$GET(UPD("DT PD"))

 +13       SET DR=DR_";106///"_$GET(UPD("PAY METH"))

 +14       SET DR=DR_";107////"_$GET(UPD("CHK DT"))

 +15       SET DR=DR_";108///"_$GET(UPD("CHK #"))

 +16       SET DR=DR_";201///"_$GET(UPD("CLSTC1"))

 +17       SET DR=DR_";202///"_$GET(UPD("CLST1"))

 +18       SET DR=DR_";203///"_$GET(UPD("EID1"))

 +19       SET DR=DR_";204///"_$GET(UPD("CLSTC2"))

 +20       SET DR=DR_";205///"_$GET(UPD("CLST2"))

 +21       SET DR=DR_";206///"_$GET(UPD("EID2"))

 +22       SET DR=DR_";207///"_$GET(UPD("CLSTC3"))

 +23       SET DR=DR_";208///"_$GET(UPD("CLST3"))

 +24       SET DR=DR_";209///"_$GET(UPD("EID3"))

 +25       SET DR=DR_";301///"_$GET(UPD("PAYOR CN"))

 +26       SET DR=DR_";302///"_$GET(UPD("PAYOR 302"))

 +27       SET DR=DR_";303///"_$GET(UPD("PAYOR 303"))

 +28       SET DR=DR_";304///"_$GET(UPD("PAYOR 304"))

 +29       SET DR=DR_";305///"_$GET(UPD("PAYOR 305"))

 +30       SET DR=DR_";306///"_$GET(UPD("PAYOR 306"))

 +31       SET DR=DR_";307///"_$GET(UPD("PAYOR 307"))

 +32       NEW UPD

 +33       DO FILE^DICN

 +34       SET BHLXHIEN=+Y

 +35       KILL DIC,DR,DA

 +36       QUIT 

 +37      ;

EOJ       ;-- kill vars

 +1        KILL ^BHLX277($JOB)

 +2        KILL ^BHLX277V($JOB)

 +3        DO EN^XBVK("BHLX")

 +4        QUIT 

 +5       ;