Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARACSI

BARACSI.m

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