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

BPSREOP1.m

Go to the documentation of this file. 
  1. BPSREOP1 ;BHAM ISC/SS - REOPEN CLOSED CLAIMS ;03/07/08  14:54
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**3,7,10,11,20**;JUN 2004;Build 27
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;Reopen closed claims
  1.  ;
  1.  ;create an ^TMP for the list manager
  1.  ;
  1. COLLECT(BPDFN,BPSTRT,BPEND) ;
  1.  D CLEAN^VALM10
  1.  N LINE
  1.  N BPIEN02,BPIEN59
  1.  S LINE=1
  1.  S BPIEN59=0
  1.  F  S BPIEN59=$O(^BPST("AC",BPDFN,BPIEN59)) Q:+BPIEN59=0  D
  1.  . I $P($G(^BPST(BPIEN59,12)),U,2)<BPSTRT Q
  1.  . I $P($G(^BPST(BPIEN59,12)),U,2)>BPEND Q
  1.  . ; Don't display deleted prescriptions
  1.  . I $$RXDEL^BPSOS($P(^BPST(BPIEN59,1),U,11),$P(^BPST(BPIEN59,1),U,1)) Q
  1.  . S BPIEN02=+$P($G(^BPST(BPIEN59,0)),U,4)
  1.  . ;if the is no BPS CLAIMS - error
  1.  . Q:BPIEN02=0
  1.  . ;if NOT closed
  1.  . I +$P($G(^BPSC(BPIEN02,900)),U)=0 Q
  1.  . D SET^VALM10(LINE,$$LJ^BPSSCR02(LINE,6)_$$CLAIMINF(BPIEN59),BPIEN59)
  1.  . S LINE=LINE+1
  1.  S VALMCNT=LINE-1 ;"of PAGE" fix - VALMCNT should be EXACT number of lines on the screen
  1.  Q
  1.  ;claim info for list manager screen
  1. CLAIMINF(BP59) ;*/
  1.  Q $$CLAIMINF^BPSSCR02(BP59)
  1.  ;
  1.  ;patient info for header
  1. PATINF(BPDFN) ;*/
  1.  N X
  1.  S X=$E($$PATNAME(BPDFN),1,22)_" "_$$SSN4^BPSSCRU2(BPDFN)
  1.  Q $$LJ^BPSSCR02(X,29) ;name
  1.  ;
  1.  ;------------ patient's name
  1. PATNAME(BPDFN) ;
  1.  Q $E($P($G(^DPT(BPDFN,0)),U),1,30)
  1.  ;
  1.  ;/**
  1.  ;ECME User Screen Reopen Closed Claim Hidden Action (ROC)
  1.  ;**/
  1. EUSCREOP ;
  1.  N BPREOP,BP59,BPDFN,BPDISP,BPCNT,BPI,BPJ,BPCOMM,BPRETV,BPIEN02,BPSRXNUM
  1.  ; Check for BPS MANAGER security key
  1.  I '$D(^XUSEC("BPS MANAGER",DUZ)) D  Q
  1.  . W !,"You must hold the BPS MANAGER Security Key to access the",!,"Reopen Closed Claims option."
  1.  . S VALMBCK="R"
  1.  . D PAUSE^VALM1
  1.  S (BP59,BPCNT,BPI,BPJ)=0
  1.  I '$D(@(VALMAR)) G REOP
  1.  D FULL^VALM1
  1.  ; Select the claim(s) to reopen
  1.  W !,"Enter the line number for the claim you want to reopen."
  1.  I $$ASKLINES^BPSSCRU4("","C",.BPREOP,VALMAR) D
  1.  . ; Build array to display to user
  1.  . F  S BP59=$O(BPREOP(BP59)) Q:BP59=""  D
  1.  . . S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
  1.  . . S BPCNT=BPCNT+1
  1.  . . I '$D(BPDISP(BPDFN)) S BPDISP(BPDFN,BPCNT)=$$LJ^BPSSCR02($$PATNAME(BPDFN)_" :",50),BPCNT=BPCNT+1
  1.  . . S BPDISP(BPDFN,BPCNT)=@VALMAR@($P(BPREOP(BP59),U,1),0)
  1.  . . ;
  1.  . . ; check for non-billable entry
  1.  . . I $$NB^BPSSCR03(BP59) D  Q
  1.  . . . S BPCNT=BPCNT+1
  1.  . . . S BPDISP(BPDFN,BPCNT)="Entry is NON BILLABLE.  There is no claim to reopen."
  1.  . . . K BPREOP(BP59)
  1.  . . . Q
  1.  . . ;
  1.  . . ; Make sure this claim is closed
  1.  . . I '$$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) D
  1.  . . . S BPCNT=BPCNT+1
  1.  . . . S BPDISP(BPDFN,BPCNT)="Claim NOT closed and cannot be reopened."
  1.  . . . K BPREOP(BP59)
  1.  . . ; Make sure the Prescription isn't deleted
  1.  . . I $$RXDEL^BPSOS($P(^BPST(BP59,1),U,11),$P(^BPST(BP59,1),U,1)) D
  1.  . . . S BPCNT=BPCNT+1
  1.  . . . S BPDISP(BPDFN,BPCNT)="The prescription has been marked DELETED and cannot be reopened."
  1.  . . . K BPREOP(BP59)
  1.  . ; Display the selected claims from the display array
  1.  . W !!,"You've chosen to reopen the following prescriptions(s) for"
  1.  . F  S BPI=$O(BPDISP(BPI)) Q:BPI=""  D
  1.  . . F  S BPJ=$O(BPDISP(BPI,BPJ)) Q:BPJ=""  D
  1.  . . . W !,BPDISP(BPI,BPJ)
  1.  . . Q
  1.  . Q
  1.  ; If there are any closed claims selected, verify if the users still wants to reopen
  1.  I $D(BPREOP) D
  1.  . W !!,"All Selected Rxs will be reopened using the same information gathered in the",!,"following prompts.",!!
  1.  . I $$YESNO^BPSSCRRS("Are you sure?(Y/N)")=1 D
  1.  . . ; Get the Reopen Comments to be stored in the BPS CLAIMS file
  1.  . . S BPCOMM=$$PROMPT("REOPEN COMMENTS","","F",1,40)
  1.  . . Q:BPCOMM["^"
  1.  . . ; Do we REALLY want to reopen the claims?
  1.  . . I $$YESNO^BPSSCRRS("ARE YOU SURE YOU WANT TO RE-OPEN THIS CLAIM? (Y/N)","No")=1 D
  1.  . . . S (BPCNT,BP59)=0
  1.  . . . ; Loop through all selected claims and reopen them one at a time
  1.  . . . ; using the same comments
  1.  . . . F  S BP59=$O(BPREOP(BP59)) Q:BP59=""  D
  1.  . . . . S BPIEN02=+$P($G(^BPST(BP59,0)),U,4)
  1.  . . . . S BPRETV=$$REOPEN^BPSBUTL(BP59,BPIEN02,$$NOW^XLFDT,+DUZ,BPCOMM)
  1.  . . . . W !,$P(BPRETV,U,2)
  1.  . . . . I +BPRETV S BPCNT=BPCNT+1
  1.  . . . . Q
  1.  . . . I BPCNT>1 W !!,BPCNT_" claims have been reopened.",! Q
  1.  . . . I BPCNT=1 W !!,"1 claim has been reopened.",! Q
  1.  . . . I BPCNT=0 W !!,"Unable to reopen claim" Q
  1.  I '$D(BPREOP) S VALMBCK="R" D PAUSE^VALM1 Q
  1.  D PAUSE^VALM1
  1.  D REDRAW^BPSSCRUD("Updating screen for reopened claims...")
  1.  Q
  1.  ;
  1. SELECT ;
  1.  I VALMCNT<1 D  Q
  1.  . W !,"No claims to select." D PAUSE^VALM1 S VALMBCK="R"
  1.  N BP59,BPQ
  1.  D FULL^VALM1
  1.  S BP59=0
  1.  S BPQ=0
  1.  F  S BPLINE=$$PROMPT("Select item","","A") D  Q:BPQ
  1.  . I BPLINE="^" S BPQ=1 Q
  1.  . I '(BPLINE?1N.N) W !,"Please select a SINGLE Rx Line Item." Q
  1.  . S BP59=+$$GET59(+BPLINE) I BP59>0 S BPQ=1 Q
  1.  . W !,"Please select a VALID Rx Line Item."
  1.  I BPLINE="^" S VALMBCK="R" Q
  1.  I BP59=0 S VALMBCK="R" W !,"Invalid selection." D PAUSE^VALM1 Q
  1.  I $$SELCLAIM(BP59)<1 S VALMBCK="R" Q
  1.  ;D RE^VALM4
  1.  D REDRAW
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. GET59(BPLINE) ;
  1.  Q +$O(^TMP("BPSREOP",$J,"VALM","IDX",BPLINE,0))
  1.  ;
  1.  ;display selected claim information
  1. SELCLAIM(BP59) ;
  1.  D FULL^VALM1
  1.  W @IOF
  1.  N BPX,BPX1,BPDFN,BPIEN02,BPCLDATA,BPCOMM,BPRETV,BPQ
  1.  S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
  1.  S BPX1=$$RXREF^BPSSCRU2(BP59)
  1.  W !,?1,$$LJ^BPSSCR02("PATIENT NAME: "_$$PATNAME(BPDFN),30)
  1.  W ?33,$$LJ^BPSSCR02("RX#: "_$$RXNUM^BPSSCRU2(+BPX1)_" "_$P(BPX1,U,2),22)
  1.  W ?57,$$LJ^BPSSCR02("DRUG: "_$$DRGNAME^BPSSCRU2(BP59),22)
  1.  ;ien in BPS CLAIMS
  1.  S BPIEN02=+$P($G(^BPST(BP59,0)),U,4)
  1.  I BPIEN02=0 W !,"BPS CLAIMS file error!" D PAUSE^VALM1 Q -1
  1.  ;Close info
  1.  S BPCLDATA=$G(^BPSC(BPIEN02,900))
  1.  ;if the is no BPS CLAIMS - error
  1.  W !,?3,"CLOSED  ",$$FORMDATE^BPSSCRU6(+$P($G(^BPSC(BPIEN02,900)),U,2),2)
  1.  W !,?4,"ECME#: "_$$ECMENUM^BPSSCRU2(BP59)_", DOS: "_$$LASTDOS^BPSUTIL2(BP59,1)
  1.  W ", RELEASE DATE: "_$$FORMDATE^BPSSCRU6($$RELDATE^BPSSCRU6(+BPX1,+$P(BPX1,U,2)),2)
  1.  W !,?4,"PLAN: ",$$PLANNAME^BPSSCRU6(BP59)," INSURANCE: ",$$INSNAME^BPSSCRU6(BP59)
  1.  W !,?4,"CLOSE REASON: ",$$CLREASON^BPSSCRU6(+$P(BPCLDATA,U,4))
  1.  W !,?4,"DROP TO PAPER: ",$S(+$P(BPCLDATA,U,5)=1:"YES",1:"NO")
  1.  W !,?4,"CLOSE USER: ",$P($G(^VA(200,+$P(BPCLDATA,U,3),0)),U)
  1.  W !!,"You have selected the CLOSED electronic claim listed above.",!
  1.  S BPCOMM=$$PROMPT("REOPEN COMMENTS","","F",1,40)
  1.  Q:BPCOMM["^" 0
  1.  S BPQ=$$YESNO^BPSSCRRS("ARE YOU SURE YOU WANT TO RE-OPEN THIS CLAIM? (Y/N)","No")
  1.  Q:BPQ<1 0
  1.  S BPRETV=$$REOPEN^BPSBUTL(BP59,BPIEN02,$$NOW^XLFDT,+DUZ,BPCOMM)
  1.  W !,$P(BPRETV,U,2),!
  1.  W !,"1 claim has been reopened.",!
  1.  D PAUSE^VALM1
  1.  Q 1
  1.  ;
  1. REDRAW ;
  1.  N BPARR
  1.  D CLEAN^VALM10
  1.  D COLLECT^BPSREOP1(BPDFN,BPSTRT,BPEND)
  1.  S VALMBCK="R"
  1.  Q
  1.  ;input:
  1.  ;BPSPROM - prompt text
  1.  ;BPSDFVL - default value (optional)
  1.  ;BPMODE - N- to enter numbers, F - free text, A - free text w/o limitations
  1.  ;returns:
  1.  ; "response"
  1.  ; or "^" for quit
  1. PROMPT(BPSPROM,BPSDFVL,BPMODE,MINLEN,MAXLEN) ;
  1.  N IR,X,Y,DIRUT,DIR
  1.  I BPMODE="N" S DIR(0)="N^::2"
  1.  I BPMODE="A" S DIR(0)="F^::2"
  1.  I BPMODE="F" S DIR(0)="F^"_MINLEN_":"_MAXLEN_":2^K:(X?1"" ""."" "") X"
  1.  S DIR("A")=BPSPROM
  1.  I $L($G(BPSDFVL))>0 S DIR("B")=$G(BPSDFVL)
  1.  D ^DIR I $D(DIRUT) Q "^"
  1.  I Y["^" Q "^"
  1.  Q Y
  1.  ;
  1.  ;Update reopen record in BPS CLAIM
  1.  ;Input:
  1.  ; BP02 - ien in BPS CLAIMS file
  1.  ; BPCLOSED - value for CLOSED field
  1.  ; BPREOPDT - reopen date/time
  1.  ; BPDUZ - user DUZ (#200 ien)
  1.  ; BPCOMM - reopen comment text
  1.  ;Output:
  1.  ; 0^message_error - error
  1.  ; 1 - success
  1. UPDREOP(BP02,BPCLOSED,BPREOPDT,BPDUZ,BPCOMM) ;
  1.  ;Now update ECME database
  1.  N RECIENS,BPDA,BPLCK,ERRARR
  1.  S RECIENS=BP02_","
  1.  S BPDA(9002313.02,RECIENS,901)=BPCLOSED ;CLOSED = "NO"
  1.  S BPDA(9002313.02,RECIENS,906)=BPREOPDT ;reopen date/time
  1.  S BPDA(9002313.02,RECIENS,907)=+BPDUZ ;user
  1.  S BPDA(9002313.02,RECIENS,908)=BPCOMM ;comment
  1.  L +^BPST(9002313.02,+BP02):10
  1.  S BPLCK=$T
  1.  I 'BPLCK Q "0^Locked record"  ;quit
  1.  D FILE^DIE("","BPDA","ERRARR")
  1.  I BPLCK L -^BPST(9002313.02,+BP02)
  1.  I $D(ERRARR) Q "0^"_ERRARR("DIERR",1,"TEXT",1)
  1.  Q 1
  1.  ;
  1.  ; Reopen Closed Claim displayed in ECME User Screen
  1. REOP ;
  1.  Q