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

BPSSCRCL.m

Go to the documentation of this file.
  1. BPSSCRCL ;BHAM ISC/SS - ECME SCREEN CLOSE CLAIMS ;05-APR-05
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,11,15,19,20,30,31**;JUN 2004;Build 16
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to FIND^PSOREJUT supported by ICR #4706
  1. ;
  1. Q
  1. ;
  1. CLO ;entry point to close claims
  1. N BPRET,BPSARR59
  1. I '$D(@(VALMAR)) Q
  1. D FULL^VALM1
  1. W !,"Enter the line numbers for the claim(s) to be closed."
  1. S BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,VALMAR)
  1. I BPRET="^" S VALMBCK="R" Q
  1. ;close claims
  1. ;update the content of the screen
  1. ;only if at least one claim was closed
  1. I $$CLOSE(.BPSARR59) D REDRAW^BPSSCRUD("Updating screen for closed claims...")
  1. E S VALMBCK="R"
  1. Q
  1. ;
  1. ;close claims
  1. ;input:
  1. ; BP59ARR - array with ptrs to BPS TRANSACTION FILE
  1. ; BP59ARR(ien59)="ien in TMP ^ number on the user screen"
  1. ;returns:
  1. ; BPCLTOT - number of closed claims
  1. CLOSE(BP59ARR) ;
  1. N BPNEWARR,BPRETV,BPREJFLG,X
  1. N BPDFN,BP59,BPIFANY,BPQ,BPCLST,BPS52,BPSRF,BPSZ,BPSECOND
  1. N BPREAS,BPCOMM,BP90ANSW,BPRCOPAY,BPRXINFO,BPCOP,BPCLTOT,BPINS,BPINSNM,BP59FRST
  1. S BPRETV=$$MKNEWARR^BPSSCR05(.BP59ARR,.BPNEWARR,.BPINS)
  1. S BPQ="",BPIFANY=0,BPREJFLG=1,BPSECOND=0
  1. S BPDFN=""
  1. F S BPDFN=$O(BPNEWARR(BPDFN)) Q:BPDFN="" D Q:BPQ="^"
  1. . W !!,"You've chosen to close the following prescription(s) for",!,$E($$PATNAME^BPSSCRU2(BPDFN),1,13)_" :"
  1. . S BP59="" F S BP59=$O(BPNEWARR(BPDFN,BP59)) Q:BP59="" D Q:BPQ="^"
  1. . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
  1. . . S BPIFANY=1,BPQ=""
  1. . . S BPREJFLG=+$P($G(BPNEWARR(BPDFN,BP59)),U,3)
  1. . . W !,@VALMAR@(+$G(BPNEWARR(BPDFN,BP59)),0)
  1. . . D DISPREJ^BPSSCRU6(BP59)
  1. . . ;
  1. . . ; don't allow the selection of non-billable entries here
  1. . . I $$NB^BPSSCR03(BP59) D S BPQ="^" Q
  1. . . . W !?6,$$EREJTXT^BPSSCR03(BP59)
  1. . . . W !,"Entry is NON BILLABLE. There is no claim to close."
  1. . . . Q
  1. . . ;
  1. . . ;can't close a closed claim. The user must reopen first.
  1. . . I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) W !,"This claim is already closed." S BPQ="^" Q
  1. . . ; Check for unresolved rejects - BPS*1*19
  1. . . S BPSZ=$$RXREF^BPSSCRU2(BP59)
  1. . . I $$FIND^PSOREJUT($P(BPSZ,U),$P(BPSZ,U,2)) D Q
  1. . . . W !,"The Prescription is currently open in the pharmacist's Third Party Payer"
  1. . . . W !,"Reject Worklist. The claim cannot be closed until action is taken by the"
  1. . . . W !,"pharmacist."
  1. . . . S BPQ="^"
  1. . . ;get claim status from transaction
  1. . . S BPCLST=$$CLAIMST^BPSSCRU3(BP59)
  1. . . ;Is this a secondary claim?
  1. . . I $P($G(^BPST(BP59,0)),U,14)=2 S BPSECOND=1
  1. . . I $P($G(^BPST(BP59,0)),U,14)<2,$$PAYABLE^BPSOSRX5($P(BPCLST,U)),$$PAYBLSEC^BPSUTIL2(BP59) D S BPQ="^" Q
  1. . . . W !,"The claim cannot be closed if the secondary claim is payable.",!,"Please reverse the secondary claim first."
  1. . . I BPSECOND,BPCLST'["E REJECTED",BPCLST'["E REVERSAL ACCEPTED" D S BPQ="^" Q
  1. . . . W !,"The CLOSE action can only be applied to an E REJECTED or E REVERSAL ACCEPTED",!,"secondary claim. This claim is ",$P(BPCLST,U),".",!,"The secondary claim is also closed when the primary claim is closed."
  1. . . W:BPREJFLG=0 !,"Claim Neither Rejected Nor Reversed and cannot be Closed."
  1. I +BPRETV=0 Q $$QUITCL()
  1. I BPQ="^" Q $$QUITCL()
  1. ;
  1. ; check 2nd insurance, but only if closing a Primary claim.
  1. S BPQ=""
  1. I 'BPSECOND D
  1. . S BPDFN="" F S BPDFN=$O(BPINS(BPDFN)) Q:BPDFN="" D Q:BPQ="^"
  1. . . S BPINSNM="" F S BPINSNM=$O(BPINS(BPDFN,BPINSNM)) Q:BPINSNM="" D Q:BPQ="^"
  1. . . . S BP59FRST=0
  1. . . . S BP59=""
  1. . . . K BPRXINFO
  1. . . . F S BP59=$O(BPINS(BPDFN,BPINSNM,BP59)) Q:BP59="" D Q:BPQ="^"
  1. . . . . S:BP59FRST=0 BP59FRST=BP59
  1. . . . . S BPRXINFO(BP59)=$E($G(@VALMAR@(+$G(BP59ARR(BP59)),0)),7,99)
  1. . . . ; Only check 2nd if the RX/Fill is released
  1. . . . S BPSZ=$$RXREF^BPSSCRU2(BP59FRST)
  1. . . . S BPS52=$P(BPSZ,U),BPSRF=$P(BPSZ,U,2)
  1. . . . Q:$$RELDATE^BPSBCKJ(BPS52,BPSRF)']""
  1. . . . ; call CH2NDINS^BPSSCRU5 only once for all claims for this patient and insurance
  1. . . . ; you can use one BP59FRST for the group of claims here as a parameter since
  1. . . . ; they all are all identical from the "patient-insurance pair" point of view
  1. . . . D:BP59FRST>0 CH2NDINS^BPSSCRU5(BP59FRST,$E($$PATNAME^BPSSCRU2(BPDFN),1,13),BPINSNM,.BPRXINFO)
  1. ;
  1. I BPQ="^" Q $$QUITCL()
  1. ;
  1. W !!,"ALL Selected Rxs will be CLOSED using the same information gathered in the",!,"following prompts.",!
  1. S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
  1. I BPQ'=1 Q $$QUITCL() ;
  1. ; ask questions for all of them
  1. W !!
  1. I $$ASKQUEST(+$P(BPRETV,U,2),.BPREAS,.BPCOMM,.BP90ANSW,.BPRCOPAY)'=1 Q $$QUITCL()
  1. ;
  1. W @IOF
  1. ;and finally close all
  1. S BPCLTOT=0
  1. S BPDFN="" F S BPDFN=$O(BPNEWARR(BPDFN)) Q:BPDFN="" D
  1. . S BP59="" F S BP59=$O(BPNEWARR(BPDFN,BP59)) Q:BP59="" D
  1. . . I $P($G(BPNEWARR(BPDFN,BP59)),U,3)=0 Q ;can't be closed
  1. . . S BPCOP=0
  1. . . I +BPRCOPAY=1,$P($G(BPNEWARR(BPDFN,BP59)),U,4)=1 S BPCOP=1 ;release copay
  1. . . I $$CLOSEIT(BP59,$P(BPREAS,U,2),BPCOMM,BP90ANSW,BPCOP)>0 D
  1. . . . S BPCLTOT=BPCLTOT+1
  1. ;
  1. W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been closed.",!
  1. D PAUSE^VALM1
  1. Q BPCLTOT
  1. ;
  1. QUITCL() ;
  1. W !!,"0 claims have been closed."
  1. D PAUSE^VALM1
  1. Q 0
  1. ;/**
  1. ;Ask all necessary questions
  1. ;Input
  1. ; BPRELCOP - ask release copay question
  1. ; .BPREAZ - ptr to #356.8 ^ CLOSE REASON NAME ^ ECME FLAG ^ ECME PAPER FLAG
  1. ; .BPCOMZ - close comment (string)
  1. ; .BP90ANSZ - "", "D"(drop to paper) or "N" (non-billable)
  1. ; .BPRCOPAZ - 1(Yes) or 0(No) , answer to "release copay" question
  1. ;Output:
  1. ; 0 - cancel process
  1. ; ^ - emergency quit (cancel process)
  1. ; 1 - ok, can proceed
  1. ASKQUEST(BPRELCOP,BPREAZ,BPCOMZ,BP90ANSZ,BPRCOPAZ) ;*/
  1. S BPCOMZ=""
  1. S BP90ANSZ=""
  1. S BPRCOPAZ=0
  1. ;ask the user to choose the close reason from #356.8
  1. ;using set of close reasons in IB file 356.8
  1. S BPREAZ=$$REASON()
  1. I BPREAZ="^" Q "^"
  1. I ($P(BPREAZ,U,4)=1) D ;if has ECME PAPER FLAG
  1. . ;ask if the claim is still billable thru paper?
  1. . S BP90ANSZ=$$PROMPT^BPSSCRCV("S^N:NON-BILLABLE;D:DROP TO PAPER","Treat as (N)on-Billable Episode or (D)rop Bill to Paper?","")
  1. I BP90ANSZ=-1 Q "^"
  1. S BPCOMZ=$$COMMENT("Comment ",40)
  1. I (BPCOMZ="^") Q "^"
  1. I $L(BPCOMZ)>0,BPCOMZ?1" "." " S BPCOMZ=""
  1. ;check copay
  1. ;ask "release copay?" in all NON-BILLABLE cases, i.e. except user answered "DROP TO PAPER"
  1. ;(even in cases when he was not asked about it)
  1. I BP90ANSZ'="D",BPRELCOP D
  1. . ; Ask user if s/he wants to release a copay
  1. . S BPRCOPAZ=$$YESNO^BPSSCRRS("Release Patient CoPay(Y/N)")
  1. I BPRCOPAZ=-1 Q "^"
  1. ;
  1. S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
  1. I BPQ=-1 Q "^" ;quit by "^"
  1. I BPQ'=1 Q 0 ;doesn't want to proceed
  1. Q 1 ; answers can be used
  1. ;
  1. ;/**
  1. ;ask for the close reason
  1. ;return:
  1. ; ptr to #356.8 ^ CLOSE REASON NAME ^ ECME FLAG ^ ECME PAPER FLAG ^ CODE ^ INACTIVE
  1. ;
  1. ; Allow the user to select an entry that has ECME FLAG set to 1 and INACTIVE flag not set to 1
  1. REASON() ;
  1. N DIC,BPREASNM,BP3568,Y
  1. ; - Asks for REASON for Closing
  1. S DIC="^IBE(356.8,",DIC(0)="AEQMZ"
  1. S DIC("S")="I ($P(^(0),U,2)=1),($P(^(0),U,5)'=1)"
  1. D ^DIC
  1. I Y=-1 Q "^"
  1. Q +Y_U_Y(0)
  1. ;/**
  1. ;enter the comment
  1. ;BPSTR -prompt string
  1. ;BPMLEN -maxlen
  1. COMMENT(BPSTR,BPMLEN) ;*/
  1. N DIR,DTOUT,DUOUT,BPQ
  1. I '$D(BPSTR) S BPSTR="Comment "
  1. I '$D(BPMLEN) S BPMLEN=40
  1. S DIR(0)="FO^0:250"
  1. S DIR("A")=BPSTR
  1. S DIR("?",1)="This response must have no more than "_BPMLEN_" characters"
  1. S DIR("?")="and must not contain embedded up arrow."
  1. S BPQ=0
  1. F D Q:+BPQ'=0
  1. . D ^DIR
  1. . I $D(DUOUT)!($D(DTOUT)) S BPQ=-1 Q
  1. . I $L(Y)'>BPMLEN S BPQ=1 Q
  1. . W !!,"This response must have no more than "_BPMLEN_" characters"
  1. . W !,"and must not contain embedded uparrow.",!
  1. . S DIR("B")=$E(Y,1,BPMLEN)
  1. Q:BPQ<0 "^"
  1. Q Y
  1. ;/**
  1. ;close the claim
  1. ;the approach and code partially borrowed from IHS code CLOSE^BPSOS6N
  1. ;BPSTRA - ptr to #9002313.59
  1. ;REASON - text name of the close reason
  1. ;BPSCLCM - comment
  1. ;BPDROP:
  1. ; "D" - DROP BILL TO PAPER
  1. ; "N" - NON-BILLABLE
  1. ;BPRELCOP - 1 (Yes) or 0 (No) release copay or not?
  1. CLOSEIT(BPSTRA,REASON,BPSCLCM,BPDROP,BPRELCOP) ;
  1. N BPSCLA,ERROR,DA,DR,BPLCK,DIE
  1. S BPSCLA=$$GET1^DIQ(9002313.59,BPSTRA,3,"I")
  1. W !,"Closing Claim ",$$GET1^DIQ(9002313.02,BPSCLA,.01),"..."
  1. S BPLCK=0
  1. L +^BPSC(BPSCLA):0
  1. I $T S BPLCK=1
  1. E W !," *** CLAIM ",$$GET1^DIQ(9002313.02,BPSCLA,.01)," IN USE ***" Q 0
  1. D CLOSE^BPSBUTL(BPSCLA,BPSTRA,REASON,$S($G(BPDROP)="D":1,1:0),BPRELCOP,BPSCLCM,.ERROR,1)
  1. I $D(ERROR) W "NOT OK" D DSPERR(ERROR) D Q 0
  1. . I BPLCK=1 L -^BPSC(BPSCLA)
  1. S DIE="^BPSC(",DA=BPSCLA,DR="901///1;902///"_$$NOW^XLFDT()_";903////"_DUZ_";904///"_REASON_";905////"_BPDROP D ^DIE
  1. I BPLCK=1 L -^BPSC(BPSCLA)
  1. H 1 W "OK"
  1. Q 1
  1. ;
  1. DSPERR(MSG) ; Display the ERROR message
  1. W !,"Error: *** ",MSG," ***"
  1. Q
  1. ;
  1. ;/**
  1. ;ECME has tried to submit the claim to insurance with the name BPINSNAM
  1. ;but the claim was rejected and now we need to determine if the patient
  1. ;has any other insurance with pharmacy coverage that can be billed for the RX
  1. ;Input:
  1. ; BP59 - pointer to file #9002313.59
  1. ; BPINSNAM - insurance that have already been used by ECME
  1. ;Output:
  1. ; 0 - not found
  1. ; 1 ^ Insurance Name ^ Group Number ^ Date of service
  1. NEXTINS(BP59,BPINSNAM) ;get insurance info by the pointer of #9002313.59
  1. N BPDOS,BPDFN,BPZZ,BP36,BPX,BPHONE,BPY,BPINSNM
  1. N BPPHARM,BPCOORD,BPINS,BPFOUND
  1. S BPY=0
  1. S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2)
  1. S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1
  1. I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1
  1. S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
  1. ; call INSUR^IBBAPI to get information about:
  1. ;1 = Insurance Company Name
  1. ;7 = Coordination of Benefits (primary, secondary, tertiary)
  1. ;15 = Pharmacy Coverage?
  1. ;18 = Group Number
  1. S BPX=$$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,7,15,18")
  1. S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
  1. . ;get pharmacy coverage
  1. . S BPPHARM=+$G(BPZZ("IBBAPI","INSUR",BP1,15))
  1. I BPX<1 Q 0
  1. D PROCINS(.BPZZ)
  1. ;check pharmacy coverage
  1. S BPFOUND=0 ;if found will be set to insurance node in the INSUR^IBBAPI array
  1. S BPPHARM=1 ;look only at those with pharmacy coverage
  1. S BPCOORD=0
  1. F S BPCOORD=+$O(BPZZ("RES",BPPHARM,BPCOORD)) Q:BPCOORD=0!(BPFOUND'=0) D
  1. . S BPINS=+$O(BPZZ("RES",BPPHARM,BPCOORD,0))
  1. . I BPINS>0 I $P($G(BPZZ("IBBAPI","INSUR",BPINS,1)),U,2)'=BPINSNAM S BPFOUND=BPINS
  1. I BPFOUND=0 Q 0
  1. Q 1_U_$P($G(BPZZ("IBBAPI","INSUR",BPFOUND,1)),U,2)_U_$P($G(BPZZ("IBBAPI","INSUR",BPFOUND,18)),U)_U_BPDOS
  1. ;
  1. ;process insurances
  1. ;input: local array returned by INSUR^IBBAPI
  1. ;output: BPZZ("RES",pharmacy coverage,coordination,insurance element # in BPZZ array)
  1. PROCINS(BPZZ) ;
  1. N BP1,BP2,BP0,BPPHONE,BPPHARM,BPCOORD
  1. S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
  1. . ;get pharmacy coverage
  1. . S BPPHARM=+$G(BPZZ("IBBAPI","INSUR",BP1,15))
  1. . ;get coordination of benefits
  1. . S BPCOORD=+$G(BPZZ("IBBAPI","INSUR",BP1,7))
  1. . ;create ^TMP to sort results by pharmacy coverage and coordination of benefits
  1. . S BPZZ("RES",BPPHARM,BPCOORD,BP1)=""
  1. Q