BARACSI ; IHS/SD/LSL - CLAIM STATUS INQUIRY (276) ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;;
DOC ;
; IHS/SD/LSL - 09/24/02 - V1.6 Patch 3 - HIPAA
; Created routine. Called by BARM/ACCM/CSI
;;
Q
; *********************************************************************
EN ; EP
; Electronic Signature test
D GIS ; Make sure GIS installed
I '+BARGIS D EXIT Q ; GIS not installed
D ^BARVKL0 ; kill namespace variables
I '$D(BARUSR) D INIT^BARUTL ; Initialize BAR environment
D MSG ; Display note
F D LOOP Q:'+BARBIL ; Ask A/R bills loop
D DISPSUM ; Display request summary
I $D(BARSUM) D ASKDEV ; Ask print
D EOP^BARUTL(1) ; Press return to continue
D EXIT ; Clean up and exit
Q
; *********************************************************************
GIS ; EP
; Verify GIS 3.01 patches 2 and 6 are present
S BARGIS=1
S BARGIS2=$$INSTALLD("GIS*3.01*2")
S BARGIS6=$$INSTALLD("GIS*3.01*6")
I 'BARGIS2!('BARGIS6) D Q
. S BARGIS=0
. W !!,$$CJ^XLFSTR("GIS V3.01 Patches 2 and 6 are required for this option",IOM)
. I 'BARGIS2 S BARSTRNG="You are missing patch 2"
. I 'BARGIS6 S BARSTRNG="You are missing patch 6"
. I 'BARGIS2,'BARGIS6 S BARSTRNG="You are missing patches 2 and 6"
. W !,$$CJ^XLFSTR(BARSTRNG,IOM)
. W !,$$CJ^XLFSTR("Please contact you site manager for assistance",IOM)
. D EOP^BARUTL(1)
Q
; *********************************************************************
;
MSG ;
S $P(BARSTAR,"*",81)=""
S $P(BARDASH,"-",81)=""
W !!!,BARSTAR
W !,"*",?79,"*"
W !,"* "
W ?3,$$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")
W ?9,"Not all insurers may be participating in the Claim Status Inquiry.",?79,"*"
W !,"*",?9,"Check your EDI PAYER LIST (SPE) for a complete list of insurers.",?79,"*"
W !,"*",?79,"*"
W !,BARSTAR,!
Q
; ********************************************************************
LOOP ;
; Find A/R bill, perform checks, populate holding file, send inquiry
; BAREPASS = Patient^DOS Start^DOS End^A/R BILL IEN
W !
K BARPAT,BARZ
S BARBIL=1 ; Bill Entry Loop Flag
S BAREPASS=$$GETBIL^BARFPST3 ; Get bills by bill, patient, or DOS
I BAREPASS=0 S BARBIL=0 Q ; No bill selected; End loop
S BARPASS=$P(BAREPASS,U,1,3) ; Patient^DOS Start^DOS End
; If no A/R Bill IEN
I '+$P(BAREPASS,U,4) D FINDBIL
Q:'+$P(BAREPASS,U,4) ; User still not Identify bill
D DISP ; Display Bill data
D EDIMSG ; Set BAREDI=0 if not EDI Payer
Q:'+BAREDI
D NOTE ; Display bill notes
D ASK ; Ask if user wants to send request
Q:'+BARSEND ; Send Claim Status Request (276) flag
D SEND ; Create entry in 90056.08, call GIS
Q:BARECLST'>0 ; Entry creation failed.
D ACCUM ; Accumulate summary data
Q
; ********************************************************************
FINDBIL ;
; ^BARPST2 sets ^TMP($J,"B",BARCNT,BILL IEN)=""
S BARASK=1
S BARCNT=$$EN^BARPST2(BARPASS) ; Count bills for DOS range
I 'BARCNT D Q ; No bills found
. W *7
. W !,"No bills found in this date range!"
I BARCNT=1 D Q ; One bill found for DOS range
. S $P(BAREPASS,U,4)=$O(^BARTMP($J,"B",BARCNT,""))
; More than one bill found for DOS range, display, ask user to select
D HIT^BARFPST3(BARPASS) ; List bills for DOS range
D ASKLIN^BARFPST3 Q:'+BARASK ; Ask user to select one
S $P(BAREPASS,U,4)=$O(^BARTMP($J,"B",BARLIN,"")) ; A/R Bill IEN
Q
; ********************************************************************
DISP ;
; Get and Display data
S BARDFN=$P(BAREPASS,U)
S BARBL=$P(BAREPASS,U,4)
D GETS^DIQ(90050.01,BARBL,".01;3;13;15;17.2;18;101;102;108;114","IE","TMP")
M BARINQ=TMP(90050.01,BARBL_",")
K TMP
S BARIENS=BARINQ(108,"I")_","_BARDFN_","
S BARINQ("HRN")=$$GET1^DIQ(9000001.41,BARIENS,.02)
S:BARINQ("HRN")="" BARINQ("HRN")="no HRN"
W $$EN^BARVDF("IOF")
W !!?4,"Patient: ",$E(BARINQ(101,"E"),1,30)," [",BARINQ("HRN"),"]",?54,"Bill: ",$E(BARINQ(.01,"E"),1,20)
W !,"A/R Account: ",$E(BARINQ(3,"E"),1,30),?47,"Bill Status: ",$E(BARINQ(17.2,"E"),1,20)
W !!,"Visit Date",?13,"Visit Type",?35,"Date Billed",?49,"Amount Billed",?65,"Current Balance"
W !,BARDASH
W !,$$SDT^BARDUTL(BARINQ(102,"I")) ; Visit Date
W ?13,$E(BARINQ(114,"E"),1,20) ; Visit Type
W ?35,$$SDT^BARDUTL(BARINQ(18,"I")) ; Date Billed
W ?49,$J($FN(BARINQ(13,"E"),",",2),13) ; Amount Billed
W ?65,$J($FN(BARINQ(15,"E"),",",2),15) ; Current Balance
Q
; ********************************************************************
EDIMSG ;
; Check EDI Payer list and Write various EDI messages
K BARMSG,BARMSG2
S BAREDI=0
D EDICHK
I $G(BARMSG)]"" D Q
. W !!?16,"**UNABLE TO REQUEST CLAIM STATUS FOR THIS BILL**"
. W !?((80-$L(BARMSG))/2),BARMSG
. I $G(BARMSG2)]"" W !?((80-$L(BARMSG2))/2),BARMSG2
S BAREDI=1
Q
; ********************************************************************
EDICHK ;
I $P($G(^BARAC(DUZ(2),BARINQ(3,"I"),0)),U)'["AUTNINS" D Q
. S BARMSG="**"_BARINQ(3,"E")_" is not an Insurer.**"
I '$D(^BAR(90052.06,DUZ(2),DUZ(2),1,BARINQ(3,"I"))) D Q
. S BARMSG="**"_BARINQ(3,"E")_" is not in the EDI PAYER LIST.**"
. S BARMSG2="**Please check Site Parameters.**"
I $D(^BAR(90052.06,DUZ(2),DUZ(2),1,BARINQ(3,"I"))) D Q
. S BARINQ("EDIPYR")=$G(^BAR(90052.06,DUZ(2),DUZ(2),1,BARINQ(3,"I"),0))
. I '+$P(BARINQ("EDIPYR"),U,2) D Q
.. S BARMSG="**"_BARINQ(3,"E")_" does not have an EDI Effective Date.**"
.. S BARMSG2="**Please check the EDI PAYER LIST in Site Parameters.**"
. I $P(BARINQ("EDIPYR"),U,2)>DT D Q
.. S BARMSG="**"_BARINQ(3,"E")_" cannot accept claim requests until "_$$SDT^BARDUTL($P(BARINQ("EDIPYR"),U,2))_".**"
.. S BARMSG2="**Please check the EFFECTIVE DATE of the EDI PAYER LIST in Site Parameters.**"
. I +$P(BARINQ("EDIPYR"),U,3),$P(BARINQ("EDIPYR"),U,3)<DT D Q
.. S BARMSG="**"_BARINQ(3,"E")_" STOPPED accepting claim requests on "_$$SDT^BARDUTL($P(BARINQ("EDIPYR"),U,3))_".**"
.. S BARMSG2="**Please check the END DATE of the EDI PAYER LIST in Site Parameters.**"
Q
; ********************************************************************
NOTE ;
K BARNOTE
S BARCNT=1
W !!!
I $D(^BARECLST("BILL",DUZ(2),BARBL)) D
. S BARTRC=$O(^BARECLST("BILL",DUZ(2),BARBL,""),-1) ; Most recent req
. S BARRQDT=$$GET1^DIQ(90056.08,BARTRC,.04) ; Request Date
. S BARRPDT=$$GET1^DIQ(90056.08,BARTRC,101) ; Response Date
. S BARNOTE(BARCNT)=BARINQ(.01,"E")_" was last submitted for status on "_BARRQDT
. S BARCNT=BARCNT+1
. I BARRPDT="" S BARNOTE(BARCNT)="and a response has yet to be received."
. E S BARNOTE(BARCNT)="and a response was received on "_BARRPDT
. S BARCNT=BARCNT+1
I BARINQ(15,"I")<.01 D
. S BARNOTE(BARCNT)=BARINQ(.01,"E")_" does NOT have a positive balance."
I $D(BARNOTE) D
. I $O(BARNOTE(""),-1)>1 W $$EN^BARVDF("RVN"),"NOTES:",$$EN^BARVDF("RVF")
. E W $$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")
. S BARCNT=0
. F S BARCNT=$O(BARNOTE(BARCNT)) Q:'+BARCNT D
.. W ?8,BARNOTE(BARCNT),!
Q
; ********************************************************************
ASK ;
; Ask user if they want to send the request
S BARSEND=0
K DIR
S DIR(0)="Y"
S DIR("A")="Do you wish to send this bill for status to "_BARINQ(3,"E")
S DIR("B")="Yes"
D ^DIR
K DIR
I Y=1 S BARSEND=1
Q
; ********************************************************************
SEND ;
; Create entry in A/R EDI CLAIM STATUS File and call GIS
S BARINQ("PYR")=$P($P(^BARAC(DUZ(2),BARINQ(3,"I"),0),U),";")
S BARINQ("PYRID")=$P($G(^AUTNINS(BARINQ("PYR"),0)),U,8)
K DIC,DA,X,Y
S DIC="^BARECLST("
S DIC(0)="LZE"
S X=$O(^BARECLST("B",""),-1)
S X=X+1
S DINUM=X
S DIC("DR")=".02///^S X=BARINQ(.01,""E"")"
S DIC("DR")=DIC("DR")_";.03////^S X=DUZ(2)"
S DIC("DR")=DIC("DR")_";.04////^S X=DT"
S DIC("DR")=DIC("DR")_";.05///^S X=BARINQ(""PYRID"")"
K DD,DO
D FILE^DICN
S BARECLST=+Y
I Y'>0 D Q
. W !!!,"*****UNABLE TO PROCESS REQUEST FOR ",BARINQ(.01,"E"),"*****"
. W !,"*****COULD NOT CREATE ENTRY IN A/R EDI CLAIM STATUS FILE*****"
;D GEN276^BAR276(BARECLST) ;Returns INHF
S BARINHF=""
I '$D(INHF) S BARINHF="*****GIS TRIGGER EVENT NOT IN PLACE*****"
I $D(INHF),'+INHF S BARINHF="*****"_INHF_"*****"
I $G(BARINHF)]"" D Q
. S DA=BARECLST
. S DIK="^BARECLST("
. D ^DIK
. W !!!,$$CJ^XLFSTR("*****UNABLE TO PROCESS REQUEST FOR "_BARINQ(.01,"E")_" *****",IOM)
. W !?((80-$L(BARINHF))/2),BARINHF
. S BARECLST=0
W ". . . SENT"
Q
; ********************************************************************
ACCUM ;
; BARSUM(A/R ACCOUNT)=BILL CNT^AMT BILLED
S $P(BARSUM(BARINQ(3,"E")),U)=$P($G(BARSUM(BARINQ(3,"E"))),U)+1
S $P(BARSUM(BARINQ(3,"E")),U,2)=$P($G(BARSUM(BARINQ(3,"E"))),U,2)+BARINQ(13,"I")
S $P(BARTOT,U)=$P($G(BARTOT),U)+1
S $P(BARTOT,U,2)=$P($G(BARTOT),U,2)+BARINQ(13,"I")
Q
; ********************************************************************
DISPSUM ;
; Display Summary when user is done entering bills
I '$D(BARSUM) D Q
. W !!!?18,"No bills were submitted for a claim status."
W $$EN^BARVDF("IOF")
W ?6,"* * * * S U M M A R Y O F S U B M I T T E D B I L L S * * * *"
W !!,"ACCEPTED TRANSMISSIONS",?60,$$MDT2^BARDUTL(DT)
W !!,"A/R Account",?40,"Bill cnt",?51,"Amount Billed"
W !,"-----------",?40,"---------",?50,"---------------",!
S BARAC=""
F S BARAC=$O(BARSUM(BARAC)) Q:BARAC="" D
. W !,BARAC
. W ?40,$J($FN($P(BARSUM(BARAC),U),",",0),9)
. W ?50,$J($FN($P(BARSUM(BARAC),U,2),",",2),15)
W !,?40,"---------",?50,"---------------"
W !,"TOTALS"
W ?40,$J($FN($P(BARTOT,U),",",0),9)
W ?50,$J($FN($P(BARTOT,U,2),",",2),15)
Q
; ********************************************************************
ASKDEV ;
; Ask if user wants to print summary
W !!
K DIR
S DIR(0)="Y"
S DIR("A")="Would you like to print this summary page?"
S DIR("B")="Yes"
D ^DIR
K DIR
Q:Y<1
; Select device
S %ZIS="N"
S %ZIS("A")="Enter DEVICE: "
D ^%ZIS Q:POP
I $D(IO("S")) S IOP=ION D ^%ZIS
D DISPSUM
D ^%ZISC
Q
; ********************************************************************
;
INSTALLD(BAR) ; EP
; Verify GIS Patch 2 and 6 present
N DIC,X,Y
S X=$P(BAR,"*")
S DIC="^DIC(9.4,"
S DIC(0)="FM"
S D="C"
D IX^DIC
I Y<1 Q 0
; 2nd look up version
S DIC=DIC_+Y_",22,"
S X=$P(BAR,"*",2)
D ^DIC
I Y<1 Q 0
; 3rd look up patch
S DIC=DIC_+Y_",""PAH"","
S X=$P(BAR,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
; *********************************************************************
;
EXIT ; EP
; Exit, kill local variables
D ^BARVKL0 ; kill namespace variables
Q
BARACSI ; IHS/SD/LSL - CLAIM STATUS INQUIRY (276) ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;;
DOC ;
+1 ; IHS/SD/LSL - 09/24/02 - V1.6 Patch 3 - HIPAA
+2 ; Created routine. Called by BARM/ACCM/CSI
+3 ;;
+4 QUIT
+5 ; *********************************************************************
EN ; EP
+1 ; Electronic Signature test
+2 ; Make sure GIS installed
DO GIS
+3 ; GIS not installed
IF '+BARGIS
DO EXIT
QUIT
+4 ; kill namespace variables
DO ^BARVKL0
+5 ; Initialize BAR environment
IF '$DATA(BARUSR)
DO INIT^BARUTL
+6 ; Display note
DO MSG
+7 ; Ask A/R bills loop
FOR
DO LOOP
IF '+BARBIL
QUIT
+8 ; Display request summary
DO DISPSUM
+9 ; Ask print
IF $DATA(BARSUM)
DO ASKDEV
+10 ; Press return to continue
DO EOP^BARUTL(1)
+11 ; Clean up and exit
DO EXIT
+12 QUIT
+13 ; *********************************************************************
GIS ; EP
+1 ; Verify GIS 3.01 patches 2 and 6 are present
+2 SET BARGIS=1
+3 SET BARGIS2=$$INSTALLD("GIS*3.01*2")
+4 SET BARGIS6=$$INSTALLD("GIS*3.01*6")
+5 IF 'BARGIS2!('BARGIS6)
Begin DoDot:1
+6 SET BARGIS=0
+7 WRITE !!,$$CJ^XLFSTR("GIS V3.01 Patches 2 and 6 are required for this option",IOM)
+8 IF 'BARGIS2
SET BARSTRNG="You are missing patch 2"
+9 IF 'BARGIS6
SET BARSTRNG="You are missing patch 6"
+10 IF 'BARGIS2
IF 'BARGIS6
SET BARSTRNG="You are missing patches 2 and 6"
+11 WRITE !,$$CJ^XLFSTR(BARSTRNG,IOM)
+12 WRITE !,$$CJ^XLFSTR("Please contact you site manager for assistance",IOM)
+13 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+14 QUIT
+15 ; *********************************************************************
+16 ;
MSG ;
+1 SET $PIECE(BARSTAR,"*",81)=""
+2 SET $PIECE(BARDASH,"-",81)=""
+3 WRITE !!!,BARSTAR
+4 WRITE !,"*",?79,"*"
+5 WRITE !,"* "
+6 WRITE ?3,$$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")
+7 WRITE ?9,"Not all insurers may be participating in the Claim Status Inquiry.",?79,"*"
+8 WRITE !,"*",?9,"Check your EDI PAYER LIST (SPE) for a complete list of insurers.",?79,"*"
+9 WRITE !,"*",?79,"*"
+10 WRITE !,BARSTAR,!
+11 QUIT
+12 ; ********************************************************************
LOOP ;
+1 ; Find A/R bill, perform checks, populate holding file, send inquiry
+2 ; BAREPASS = Patient^DOS Start^DOS End^A/R BILL IEN
+3 WRITE !
+4 KILL BARPAT,BARZ
+5 ; Bill Entry Loop Flag
SET BARBIL=1
+6 ; Get bills by bill, patient, or DOS
SET BAREPASS=$$GETBIL^BARFPST3
+7 ; No bill selected; End loop
IF BAREPASS=0
SET BARBIL=0
QUIT
+8 ; Patient^DOS Start^DOS End
SET BARPASS=$PIECE(BAREPASS,U,1,3)
+9 ; If no A/R Bill IEN
+10 IF '+$PIECE(BAREPASS,U,4)
DO FINDBIL
+11 ; User still not Identify bill
IF '+$PIECE(BAREPASS,U,4)
QUIT
+12 ; Display Bill data
DO DISP
+13 ; Set BAREDI=0 if not EDI Payer
DO EDIMSG
+14 IF '+BAREDI
QUIT
+15 ; Display bill notes
DO NOTE
+16 ; Ask if user wants to send request
DO ASK
+17 ; Send Claim Status Request (276) flag
IF '+BARSEND
QUIT
+18 ; Create entry in 90056.08, call GIS
DO SEND
+19 ; Entry creation failed.
IF BARECLST'>0
QUIT
+20 ; Accumulate summary data
DO ACCUM
+21 QUIT
+22 ; ********************************************************************
FINDBIL ;
+1 ; ^BARPST2 sets ^TMP($J,"B",BARCNT,BILL IEN)=""
+2 SET BARASK=1
+3 ; Count bills for DOS range
SET BARCNT=$$EN^BARPST2(BARPASS)
+4 ; No bills found
IF 'BARCNT
Begin DoDot:1
+5 WRITE *7
+6 WRITE !,"No bills found in this date range!"
End DoDot:1
QUIT
+7 ; One bill found for DOS range
IF BARCNT=1
Begin DoDot:1
+8 SET $PIECE(BAREPASS,U,4)=$ORDER(^BARTMP($JOB,"B",BARCNT,""))
End DoDot:1
QUIT
+9 ; More than one bill found for DOS range, display, ask user to select
+10 ; List bills for DOS range
DO HIT^BARFPST3(BARPASS)
+11 ; Ask user to select one
DO ASKLIN^BARFPST3
IF '+BARASK
QUIT
+12 ; A/R Bill IEN
SET $PIECE(BAREPASS,U,4)=$ORDER(^BARTMP($JOB,"B",BARLIN,""))
+13 QUIT
+14 ; ********************************************************************
DISP ;
+1 ; Get and Display data
+2 SET BARDFN=$PIECE(BAREPASS,U)
+3 SET BARBL=$PIECE(BAREPASS,U,4)
+4 DO GETS^DIQ(90050.01,BARBL,".01;3;13;15;17.2;18;101;102;108;114","IE","TMP")
+5 MERGE BARINQ=TMP(90050.01,BARBL_",")
+6 KILL TMP
+7 SET BARIENS=BARINQ(108,"I")_","_BARDFN_","
+8 SET BARINQ("HRN")=$$GET1^DIQ(9000001.41,BARIENS,.02)
+9 IF BARINQ("HRN")=""
SET BARINQ("HRN")="no HRN"
+10 WRITE $$EN^BARVDF("IOF")
+11 WRITE !!?4,"Patient: ",$EXTRACT(BARINQ(101,"E"),1,30)," [",BARINQ("HRN"),"]",?54,"Bill: ",$EXTRACT(BARINQ(.01,"E"),1,20)
+12 WRITE !,"A/R Account: ",$EXTRACT(BARINQ(3,"E"),1,30),?47,"Bill Status: ",$EXTRACT(BARINQ(17.2,"E"),1,20)
+13 WRITE !!,"Visit Date",?13,"Visit Type",?35,"Date Billed",?49,"Amount Billed",?65,"Current Balance"
+14 WRITE !,BARDASH
+15 ; Visit Date
WRITE !,$$SDT^BARDUTL(BARINQ(102,"I"))
+16 ; Visit Type
WRITE ?13,$EXTRACT(BARINQ(114,"E"),1,20)
+17 ; Date Billed
WRITE ?35,$$SDT^BARDUTL(BARINQ(18,"I"))
+18 ; Amount Billed
WRITE ?49,$JUSTIFY($FNUMBER(BARINQ(13,"E"),",",2),13)
+19 ; Current Balance
WRITE ?65,$JUSTIFY($FNUMBER(BARINQ(15,"E"),",",2),15)
+20 QUIT
+21 ; ********************************************************************
EDIMSG ;
+1 ; Check EDI Payer list and Write various EDI messages
+2 KILL BARMSG,BARMSG2
+3 SET BAREDI=0
+4 DO EDICHK
+5 IF $GET(BARMSG)]""
Begin DoDot:1
+6 WRITE !!?16,"**UNABLE TO REQUEST CLAIM STATUS FOR THIS BILL**"
+7 WRITE !?((80-$LENGTH(BARMSG))/2),BARMSG
+8 IF $GET(BARMSG2)]""
WRITE !?((80-$LENGTH(BARMSG2))/2),BARMSG2
End DoDot:1
QUIT
+9 SET BAREDI=1
+10 QUIT
+11 ; ********************************************************************
EDICHK ;
+1 IF $PIECE($GET(^BARAC(DUZ(2),BARINQ(3,"I"),0)),U)'["AUTNINS"
Begin DoDot:1
+2 SET BARMSG="**"_BARINQ(3,"E")_" is not an Insurer.**"
End DoDot:1
QUIT
+3 IF '$DATA(^BAR(90052.06,DUZ(2),DUZ(2),1,BARINQ(3,"I")))
Begin DoDot:1
+4 SET BARMSG="**"_BARINQ(3,"E")_" is not in the EDI PAYER LIST.**"
+5 SET BARMSG2="**Please check Site Parameters.**"
End DoDot:1
QUIT
+6 IF $DATA(^BAR(90052.06,DUZ(2),DUZ(2),1,BARINQ(3,"I")))
Begin DoDot:1
+7 SET BARINQ("EDIPYR")=$GET(^BAR(90052.06,DUZ(2),DUZ(2),1,BARINQ(3,"I"),0))
+8 IF '+$PIECE(BARINQ("EDIPYR"),U,2)
Begin DoDot:2
+9 SET BARMSG="**"_BARINQ(3,"E")_" does not have an EDI Effective Date.**"
+10 SET BARMSG2="**Please check the EDI PAYER LIST in Site Parameters.**"
End DoDot:2
QUIT
+11 IF $PIECE(BARINQ("EDIPYR"),U,2)>DT
Begin DoDot:2
+12 SET BARMSG="**"_BARINQ(3,"E")_" cannot accept claim requests until "_$$SDT^BARDUTL($PIECE(BARINQ("EDIPYR"),U,2))_".**"
+13 SET BARMSG2="**Please check the EFFECTIVE DATE of the EDI PAYER LIST in Site Parameters.**"
End DoDot:2
QUIT
+14 IF +$PIECE(BARINQ("EDIPYR"),U,3)
IF $PIECE(BARINQ("EDIPYR"),U,3)<DT
Begin DoDot:2
+15 SET BARMSG="**"_BARINQ(3,"E")_" STOPPED accepting claim requests on "_$$SDT^BARDUTL($PIECE(BARINQ("EDIPYR"),U,3))_".**"
+16 SET BARMSG2="**Please check the END DATE of the EDI PAYER LIST in Site Parameters.**"
End DoDot:2
QUIT
End DoDot:1
QUIT
+17 QUIT
+18 ; ********************************************************************
NOTE ;
+1 KILL BARNOTE
+2 SET BARCNT=1
+3 WRITE !!!
+4 IF $DATA(^BARECLST("BILL",DUZ(2),BARBL))
Begin DoDot:1
+5 ; Most recent req
SET BARTRC=$ORDER(^BARECLST("BILL",DUZ(2),BARBL,""),-1)
+6 ; Request Date
SET BARRQDT=$$GET1^DIQ(90056.08,BARTRC,.04)
+7 ; Response Date
SET BARRPDT=$$GET1^DIQ(90056.08,BARTRC,101)
+8 SET BARNOTE(BARCNT)=BARINQ(.01,"E")_" was last submitted for status on "_BARRQDT
+9 SET BARCNT=BARCNT+1
+10 IF BARRPDT=""
SET BARNOTE(BARCNT)="and a response has yet to be received."
+11 IF '$TEST
SET BARNOTE(BARCNT)="and a response was received on "_BARRPDT
+12 SET BARCNT=BARCNT+1
End DoDot:1
+13 IF BARINQ(15,"I")<.01
Begin DoDot:1
+14 SET BARNOTE(BARCNT)=BARINQ(.01,"E")_" does NOT have a positive balance."
End DoDot:1
+15 IF $DATA(BARNOTE)
Begin DoDot:1
+16 IF $ORDER(BARNOTE(""),-1)>1
WRITE $$EN^BARVDF("RVN"),"NOTES:",$$EN^BARVDF("RVF")
+17 IF '$TEST
WRITE $$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")
+18 SET BARCNT=0
+19 FOR
SET BARCNT=$ORDER(BARNOTE(BARCNT))
IF '+BARCNT
QUIT
Begin DoDot:2
+20 WRITE ?8,BARNOTE(BARCNT),!
End DoDot:2
End DoDot:1
+21 QUIT
+22 ; ********************************************************************
ASK ;
+1 ; Ask user if they want to send the request
+2 SET BARSEND=0
+3 KILL DIR
+4 SET DIR(0)="Y"
+5 SET DIR("A")="Do you wish to send this bill for status to "_BARINQ(3,"E")
+6 SET DIR("B")="Yes"
+7 DO ^DIR
+8 KILL DIR
+9 IF Y=1
SET BARSEND=1
+10 QUIT
+11 ; ********************************************************************
SEND ;
+1 ; Create entry in A/R EDI CLAIM STATUS File and call GIS
+2 SET BARINQ("PYR")=$PIECE($PIECE(^BARAC(DUZ(2),BARINQ(3,"I"),0),U),";")
+3 SET BARINQ("PYRID")=$PIECE($GET(^AUTNINS(BARINQ("PYR"),0)),U,8)
+4 KILL DIC,DA,X,Y
+5 SET DIC="^BARECLST("
+6 SET DIC(0)="LZE"
+7 SET X=$ORDER(^BARECLST("B",""),-1)
+8 SET X=X+1
+9 SET DINUM=X
+10 SET DIC("DR")=".02///^S X=BARINQ(.01,""E"")"
+11 SET DIC("DR")=DIC("DR")_";.03////^S X=DUZ(2)"
+12 SET DIC("DR")=DIC("DR")_";.04////^S X=DT"
+13 SET DIC("DR")=DIC("DR")_";.05///^S X=BARINQ(""PYRID"")"
+14 KILL DD,DO
+15 DO FILE^DICN
+16 SET BARECLST=+Y
+17 IF Y'>0
Begin DoDot:1
+18 WRITE !!!,"*****UNABLE TO PROCESS REQUEST FOR ",BARINQ(.01,"E"),"*****"
+19 WRITE !,"*****COULD NOT CREATE ENTRY IN A/R EDI CLAIM STATUS FILE*****"
End DoDot:1
QUIT
+20 ;D GEN276^BAR276(BARECLST) ;Returns INHF
+21 SET BARINHF=""
+22 IF '$DATA(INHF)
SET BARINHF="*****GIS TRIGGER EVENT NOT IN PLACE*****"
+23 IF $DATA(INHF)
IF '+INHF
SET BARINHF="*****"_INHF_"*****"
+24 IF $GET(BARINHF)]""
Begin DoDot:1
+25 SET DA=BARECLST
+26 SET DIK="^BARECLST("
+27 DO ^DIK
+28 WRITE !!!,$$CJ^XLFSTR("*****UNABLE TO PROCESS REQUEST FOR "_BARINQ(.01,"E")_" *****",IOM)
+29 WRITE !?((80-$LENGTH(BARINHF))/2),BARINHF
+30 SET BARECLST=0
End DoDot:1
QUIT
+31 WRITE ". . . SENT"
+32 QUIT
+33 ; ********************************************************************
ACCUM ;
+1 ; BARSUM(A/R ACCOUNT)=BILL CNT^AMT BILLED
+2 SET $PIECE(BARSUM(BARINQ(3,"E")),U)=$PIECE($GET(BARSUM(BARINQ(3,"E"))),U)+1
+3 SET $PIECE(BARSUM(BARINQ(3,"E")),U,2)=$PIECE($GET(BARSUM(BARINQ(3,"E"))),U,2)+BARINQ(13,"I")
+4 SET $PIECE(BARTOT,U)=$PIECE($GET(BARTOT),U)+1
+5 SET $PIECE(BARTOT,U,2)=$PIECE($GET(BARTOT),U,2)+BARINQ(13,"I")
+6 QUIT
+7 ; ********************************************************************
DISPSUM ;
+1 ; Display Summary when user is done entering bills
+2 IF '$DATA(BARSUM)
Begin DoDot:1
+3 WRITE !!!?18,"No bills were submitted for a claim status."
End DoDot:1
QUIT
+4 WRITE $$EN^BARVDF("IOF")
+5 WRITE ?6,"* * * * S U M M A R Y O F S U B M I T T E D B I L L S * * * *"
+6 WRITE !!,"ACCEPTED TRANSMISSIONS",?60,$$MDT2^BARDUTL(DT)
+7 WRITE !!,"A/R Account",?40,"Bill cnt",?51,"Amount Billed"
+8 WRITE !,"-----------",?40,"---------",?50,"---------------",!
+9 SET BARAC=""
+10 FOR
SET BARAC=$ORDER(BARSUM(BARAC))
IF BARAC=""
QUIT
Begin DoDot:1
+11 WRITE !,BARAC
+12 WRITE ?40,$JUSTIFY($FNUMBER($PIECE(BARSUM(BARAC),U),",",0),9)
+13 WRITE ?50,$JUSTIFY($FNUMBER($PIECE(BARSUM(BARAC),U,2),",",2),15)
End DoDot:1
+14 WRITE !,?40,"---------",?50,"---------------"
+15 WRITE !,"TOTALS"
+16 WRITE ?40,$JUSTIFY($FNUMBER($PIECE(BARTOT,U),",",0),9)
+17 WRITE ?50,$JUSTIFY($FNUMBER($PIECE(BARTOT,U,2),",",2),15)
+18 QUIT
+19 ; ********************************************************************
ASKDEV ;
+1 ; Ask if user wants to print summary
+2 WRITE !!
+3 KILL DIR
+4 SET DIR(0)="Y"
+5 SET DIR("A")="Would you like to print this summary page?"
+6 SET DIR("B")="Yes"
+7 DO ^DIR
+8 KILL DIR
+9 IF Y<1
QUIT
+10 ; Select device
+11 SET %ZIS="N"
+12 SET %ZIS("A")="Enter DEVICE: "
+13 DO ^%ZIS
IF POP
QUIT
+14 IF $DATA(IO("S"))
SET IOP=ION
DO ^%ZIS
+15 DO DISPSUM
+16 DO ^%ZISC
+17 QUIT
+18 ; ********************************************************************
+19 ;
INSTALLD(BAR) ; EP
+1 ; Verify GIS Patch 2 and 6 present
+2 NEW DIC,X,Y
+3 SET X=$PIECE(BAR,"*")
+4 SET DIC="^DIC(9.4,"
+5 SET DIC(0)="FM"
+6 SET D="C"
+7 DO IX^DIC
+8 IF Y<1
QUIT 0
+9 ; 2nd look up version
+10 SET DIC=DIC_+Y_",22,"
+11 SET X=$PIECE(BAR,"*",2)
+12 DO ^DIC
+13 IF Y<1
QUIT 0
+14 ; 3rd look up patch
+15 SET DIC=DIC_+Y_",""PAH"","
+16 SET X=$PIECE(BAR,"*",3)
+17 DO ^DIC
+18 QUIT $SELECT(Y<1:0,1:1)
+19 ; *********************************************************************
+20 ;
EXIT ; EP
+1 ; Exit, kill local variables
+2 ; kill namespace variables
DO ^BARVKL0
+3 QUIT
