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