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