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 ;
