BPSSCRN0 ;ALB/ESG - ECME user screen open/close non-billable entry ;21-SEP-2015
;;1.0;E CLAIMS MGMT ENGINE;**20,24**;JUN 2004;Build 43
;;Per VA Directive 6402, this routine should not be modified.
;
OC ; entry point for open/close non-billable entry action
N BPRET,BP59,CLTOOP,JJ1,JJ2,JJ3,DFN,BPSSCRLN,BLN,COMMENT,BPQ,DIE,DA,DR,X,Y
N BPRET1,BPSARR59,BPSARR59A
D FULL^VALM1
W "Open/Close Non-Billable Entry"
W !,"Enter the line numbers for the entry/entries to be opened or closed."
S BPRET=$$ASKLINES^BPSSCRU4("Select items","C",.BPSARR59,VALMAR)
I BPRET="^" G OCX
; Sort chosen entries
; BPRET1= # of Billable Claims^# of Open (Non-Billable) Claims^# of Closed (NB) Claims
S BPRET1=$$OCNARR(.BPSARR59,.BPSARR59A)
I $P(BPRET1,"^",2)+$P(BPRET1,"^",3)=0 D G OCX
. W !!,"The selected entries must be Non-Billable. Please try again."
. D PAUSE^VALM1
;
; Display Billable claims that will not be included.
I $P(BPRET1,"^")'=0 D I BPQ="^" G OCX
. W !!,"Selected entries must be Non-Billable."
. W !,"The following entries are not Non-Billable and will not be included for"
. S BPSPT=""
. S BPQ=""
. F S BPSPT=$O(BPSARR59A(1,BPSPT)) Q:BPSPT="" D Q:BPQ="^"
. . W !,BPSPT," :"
. . S BPS59=""
. . F S BPS59=$O(BPSARR59A(1,BPSPT,BPS59)) Q:BPS59="" D Q:BPQ="^"
. . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
. . . W !,@VALMAR@(+$G(BPSARR59A(1,BPSPT,BPS59)),0)
. . . D DISPREJ^BPSSCRU6(BPS59)
;
; Display open claims to be closed.
I $P(BPRET1,"^",2)'=0 D I BPQ="^" G OCX
. W !!,"You've chosen to CLOSE the following prescription(s) for"
. S BPSPT=""
. S BPQ=""
. F S BPSPT=$O(BPSARR59A(2,BPSPT)) Q:BPSPT="" D Q:BPQ="^"
. . W !,BPSPT," :"
. . S BPS59=""
. . F S BPS59=$O(BPSARR59A(2,BPSPT,BPS59)) Q:BPS59="" D Q:BPQ="^"
. . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
. . . W !,@VALMAR@(+$G(BPSARR59A(2,BPSPT,BPS59)),0)
. . . D DISPREJ^BPSSCRU6(BPS59)
;
;Display closed claims to be opened.
I $P(BPRET1,"^",3)'=0 D I BPQ="^" G OCX
. W !!,"You've chosen to OPEN the following prescription(s) for"
. S BPSPT=""
. S BPQ=""
. F S BPSPT=$O(BPSARR59A(3,BPSPT)) Q:BPSPT="" D Q:BPQ="^"
. . W !,BPSPT," :"
. . S BPS59=""
. . F S BPS59=$O(BPSARR59A(3,BPSPT,BPS59)) Q:BPS59="" D Q:BPQ="^"
. . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
. . . W !,@VALMAR@(+$G(BPSARR59A(3,BPSPT,BPS59)),0)
. . . D DISPREJ^BPSSCRU6(BPS59)
;
S BPSPRMPT=""
I $P(BPRET1,"^",3)'=0,$P(BPRET1,"^",2)=0 S BPSPRMPT="OPENED"
I $P(BPRET1,"^",2)'=0,$P(BPRET1,"^",3)=0 S BPSPRMPT="CLOSED"
I $P(BPRET1,"^",2)'=0,$P(BPRET1,"^",3)'=0 S BPSPRMPT="OPENED/CLOSED"
;
W !!,"ALL Selected Non-Billable Rxs will be "_BPSPRMPT_" using the"
W !,"same information gathered in the following prompt.",!
;
COMQ ; capture the free text comments
S COMMENT=$$COMMENT^BPSSCRCL("Comment ",40)
I COMMENT=U W !!,"No changes made." D PAUSE^VALM1 G OCX
S COMMENT=$$TRIM^XLFSTR(COMMENT) ; remove leading or trailing spaces
I '$L(COMMENT) W $C(7),!,"This is a required response. Enter '^' to exit" G COMQ
;
S BPQ=$$YESNO^BPSSCRRS("Are you sure? (Y/N)")
I BPQ'=1 W !!,"No changes made." D PAUSE^VALM1 G OCX
;
; time to file
S DIE=9002313.59
;
; Loop through closed claims to be re-opened.
I $P(BPRET1,"^",3)'=0 D
. S BPSPT=""
. F S BPSPT=$O(BPSARR59A(3,BPSPT)) Q:BPSPT="" D
. . S DA=""
. . F S DA=$O(BPSARR59A(3,BPSPT,DA)) Q:DA="" D
. . . S DR="302////0;306////"_$$NOW^XLFDT
. . . S DR=DR_";307////^S X=DUZ;308////^S X=COMMENT"
. . . D ^DIE
;
; Loop through open claims to be closed.
I $P(BPRET1,"^",2)'=0 D
. S BPSPT=""
. F S BPSPT=$O(BPSARR59A(2,BPSPT)) Q:BPSPT="" D
. . S DA=""
. . F S DA=$O(BPSARR59A(2,BPSPT,DA)) Q:DA="" D
. . . S DR="302////1;303////"_$$NOW^XLFDT
. . . S DR=DR_";304////^S X=DUZ;305////^S X=COMMENT"
. . . D ^DIE
;
D PAUSE^VALM1
D REDRAW^BPSSCRUD("Updating screen ...")
;
OCX ;
I $G(BPQ)="^" D
. W !,"0 claims have been opened/closed."
. D PAUSE^VALM1
S VALMBCK="R"
Q
;
OCNARR(BPARR,BPARR1) ; Re-sort array of user selected claims
; The user selected claims will be re-sorted, dividing them by
; Billable Claims, Non-Billable Open Claims and NB Closed Claims.
; The claims will also be sorted, within each grouping, alphabetically
; by Patient Name.
; BPARR - input - array of user selected claims
; BPARR1 - output - array of user selected claims; re-sorted
; BPARR1(1,PATIENT,BPS TRANSACTION) = Billable Claims
; BPARR1(2,PATIENT,BPS TRANSACTION) = Non-Billable Open Claims
; BPARR1(3,PATIENT,BPS TRANSACTION) = Non-Billable Closed Claims
; Function Return Value = Counts of each category from BPARR1
; # of Billable Claims^# of Open NB Claims^# of Closed NB Claims
;
N BPS59,BPSCLO,BPSCNT,BPSOPN,BPSPT,BPSBILL
S BPSCNT=0,BPSOPN=0,BPSCLO=0
S BPS59=""
F S BPS59=$O(BPARR(BPS59)) Q:BPS59="" D
. ; Patient Name
. S BPSPT=$$GET1^DIQ(9002313.59,BPS59,5)
. ; Billable=0 Non-Billable=1
. S BPSBILL=$$NB^BPSSCR03(BPS59)
. I BPSBILL=0 D Q
. . S BPARR1(1,BPSPT,BPS59)=BPARR(BPS59)
. . S BPSCNT=BPSCNT+1
. ; Only Non-Billable Claims at this point
. ; Open=0 Closed=1
. S BPSOPNCLO=$$NBCL^BPSSCR03(BPS59)
. I BPSOPNCLO=0 D Q
. . S BPARR1(2,BPSPT,BPS59)=BPARR(BPS59)
. . S BPSOPN=BPSOPN+1
. S BPARR1(3,BPSPT,BPS59)=BPARR(BPS59)
. S BPSCLO=BPSCLO+1
Q BPSCNT_"^"_BPSOPN_"^"_BPSCLO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRN0 5448 printed Nov 22, 2024@17:03:25 Page 2
BPSSCRN0 ;ALB/ESG - ECME user screen open/close non-billable entry ;21-SEP-2015
+1 ;;1.0;E CLAIMS MGMT ENGINE;**20,24**;JUN 2004;Build 43
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
OC ; entry point for open/close non-billable entry action
+1 NEW BPRET,BP59,CLTOOP,JJ1,JJ2,JJ3,DFN,BPSSCRLN,BLN,COMMENT,BPQ,DIE,DA,DR,X,Y
+2 NEW BPRET1,BPSARR59,BPSARR59A
+3 DO FULL^VALM1
+4 WRITE "Open/Close Non-Billable Entry"
+5 WRITE !,"Enter the line numbers for the entry/entries to be opened or closed."
+6 SET BPRET=$$ASKLINES^BPSSCRU4("Select items","C",.BPSARR59,VALMAR)
+7 IF BPRET="^"
GOTO OCX
+8 ; Sort chosen entries
+9 ; BPRET1= # of Billable Claims^# of Open (Non-Billable) Claims^# of Closed (NB) Claims
+10 SET BPRET1=$$OCNARR(.BPSARR59,.BPSARR59A)
+11 IF $PIECE(BPRET1,"^",2)+$PIECE(BPRET1,"^",3)=0
Begin DoDot:1
+12 WRITE !!,"The selected entries must be Non-Billable. Please try again."
+13 DO PAUSE^VALM1
End DoDot:1
GOTO OCX
+14 ;
+15 ; Display Billable claims that will not be included.
+16 IF $PIECE(BPRET1,"^")'=0
Begin DoDot:1
+17 WRITE !!,"Selected entries must be Non-Billable."
+18 WRITE !,"The following entries are not Non-Billable and will not be included for"
+19 SET BPSPT=""
+20 SET BPQ=""
+21 FOR
SET BPSPT=$ORDER(BPSARR59A(1,BPSPT))
if BPSPT=""
QUIT
Begin DoDot:2
+22 WRITE !,BPSPT," :"
+23 SET BPS59=""
+24 FOR
SET BPS59=$ORDER(BPSARR59A(1,BPSPT,BPS59))
if BPS59=""
QUIT
Begin DoDot:3
+25 IF $Y>20
DO PAUSE^VALM1
WRITE @IOF
IF X="^"
SET BPQ="^"
QUIT
+26 WRITE !,@VALMAR@(+$GET(BPSARR59A(1,BPSPT,BPS59)),0)
+27 DO DISPREJ^BPSSCRU6(BPS59)
End DoDot:3
if BPQ="^"
QUIT
End DoDot:2
if BPQ="^"
QUIT
End DoDot:1
IF BPQ="^"
GOTO OCX
+28 ;
+29 ; Display open claims to be closed.
+30 IF $PIECE(BPRET1,"^",2)'=0
Begin DoDot:1
+31 WRITE !!,"You've chosen to CLOSE the following prescription(s) for"
+32 SET BPSPT=""
+33 SET BPQ=""
+34 FOR
SET BPSPT=$ORDER(BPSARR59A(2,BPSPT))
if BPSPT=""
QUIT
Begin DoDot:2
+35 WRITE !,BPSPT," :"
+36 SET BPS59=""
+37 FOR
SET BPS59=$ORDER(BPSARR59A(2,BPSPT,BPS59))
if BPS59=""
QUIT
Begin DoDot:3
+38 IF $Y>20
DO PAUSE^VALM1
WRITE @IOF
IF X="^"
SET BPQ="^"
QUIT
+39 WRITE !,@VALMAR@(+$GET(BPSARR59A(2,BPSPT,BPS59)),0)
+40 DO DISPREJ^BPSSCRU6(BPS59)
End DoDot:3
if BPQ="^"
QUIT
End DoDot:2
if BPQ="^"
QUIT
End DoDot:1
IF BPQ="^"
GOTO OCX
+41 ;
+42 ;Display closed claims to be opened.
+43 IF $PIECE(BPRET1,"^",3)'=0
Begin DoDot:1
+44 WRITE !!,"You've chosen to OPEN the following prescription(s) for"
+45 SET BPSPT=""
+46 SET BPQ=""
+47 FOR
SET BPSPT=$ORDER(BPSARR59A(3,BPSPT))
if BPSPT=""
QUIT
Begin DoDot:2
+48 WRITE !,BPSPT," :"
+49 SET BPS59=""
+50 FOR
SET BPS59=$ORDER(BPSARR59A(3,BPSPT,BPS59))
if BPS59=""
QUIT
Begin DoDot:3
+51 IF $Y>20
DO PAUSE^VALM1
WRITE @IOF
IF X="^"
SET BPQ="^"
QUIT
+52 WRITE !,@VALMAR@(+$GET(BPSARR59A(3,BPSPT,BPS59)),0)
+53 DO DISPREJ^BPSSCRU6(BPS59)
End DoDot:3
if BPQ="^"
QUIT
End DoDot:2
if BPQ="^"
QUIT
End DoDot:1
IF BPQ="^"
GOTO OCX
+54 ;
+55 SET BPSPRMPT=""
+56 IF $PIECE(BPRET1,"^",3)'=0
IF $PIECE(BPRET1,"^",2)=0
SET BPSPRMPT="OPENED"
+57 IF $PIECE(BPRET1,"^",2)'=0
IF $PIECE(BPRET1,"^",3)=0
SET BPSPRMPT="CLOSED"
+58 IF $PIECE(BPRET1,"^",2)'=0
IF $PIECE(BPRET1,"^",3)'=0
SET BPSPRMPT="OPENED/CLOSED"
+59 ;
+60 WRITE !!,"ALL Selected Non-Billable Rxs will be "_BPSPRMPT_" using the"
+61 WRITE !,"same information gathered in the following prompt.",!
+62 ;
COMQ ; capture the free text comments
+1 SET COMMENT=$$COMMENT^BPSSCRCL("Comment ",40)
+2 IF COMMENT=U
WRITE !!,"No changes made."
DO PAUSE^VALM1
GOTO OCX
+3 ; remove leading or trailing spaces
SET COMMENT=$$TRIM^XLFSTR(COMMENT)
+4 IF '$LENGTH(COMMENT)
WRITE $CHAR(7),!,"This is a required response. Enter '^' to exit"
GOTO COMQ
+5 ;
+6 SET BPQ=$$YESNO^BPSSCRRS("Are you sure? (Y/N)")
+7 IF BPQ'=1
WRITE !!,"No changes made."
DO PAUSE^VALM1
GOTO OCX
+8 ;
+9 ; time to file
+10 SET DIE=9002313.59
+11 ;
+12 ; Loop through closed claims to be re-opened.
+13 IF $PIECE(BPRET1,"^",3)'=0
Begin DoDot:1
+14 SET BPSPT=""
+15 FOR
SET BPSPT=$ORDER(BPSARR59A(3,BPSPT))
if BPSPT=""
QUIT
Begin DoDot:2
+16 SET DA=""
+17 FOR
SET DA=$ORDER(BPSARR59A(3,BPSPT,DA))
if DA=""
QUIT
Begin DoDot:3
+18 SET DR="302////0;306////"_$$NOW^XLFDT
+19 SET DR=DR_";307////^S X=DUZ;308////^S X=COMMENT"
+20 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 ; Loop through open claims to be closed.
+23 IF $PIECE(BPRET1,"^",2)'=0
Begin DoDot:1
+24 SET BPSPT=""
+25 FOR
SET BPSPT=$ORDER(BPSARR59A(2,BPSPT))
if BPSPT=""
QUIT
Begin DoDot:2
+26 SET DA=""
+27 FOR
SET DA=$ORDER(BPSARR59A(2,BPSPT,DA))
if DA=""
QUIT
Begin DoDot:3
+28 SET DR="302////1;303////"_$$NOW^XLFDT
+29 SET DR=DR_";304////^S X=DUZ;305////^S X=COMMENT"
+30 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 DO PAUSE^VALM1
+33 DO REDRAW^BPSSCRUD("Updating screen ...")
+34 ;
OCX ;
+1 IF $GET(BPQ)="^"
Begin DoDot:1
+2 WRITE !,"0 claims have been opened/closed."
+3 DO PAUSE^VALM1
End DoDot:1
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
OCNARR(BPARR,BPARR1) ; Re-sort array of user selected claims
+1 ; The user selected claims will be re-sorted, dividing them by
+2 ; Billable Claims, Non-Billable Open Claims and NB Closed Claims.
+3 ; The claims will also be sorted, within each grouping, alphabetically
+4 ; by Patient Name.
+5 ; BPARR - input - array of user selected claims
+6 ; BPARR1 - output - array of user selected claims; re-sorted
+7 ; BPARR1(1,PATIENT,BPS TRANSACTION) = Billable Claims
+8 ; BPARR1(2,PATIENT,BPS TRANSACTION) = Non-Billable Open Claims
+9 ; BPARR1(3,PATIENT,BPS TRANSACTION) = Non-Billable Closed Claims
+10 ; Function Return Value = Counts of each category from BPARR1
+11 ; # of Billable Claims^# of Open NB Claims^# of Closed NB Claims
+12 ;
+13 NEW BPS59,BPSCLO,BPSCNT,BPSOPN,BPSPT,BPSBILL
+14 SET BPSCNT=0
SET BPSOPN=0
SET BPSCLO=0
+15 SET BPS59=""
+16 FOR
SET BPS59=$ORDER(BPARR(BPS59))
if BPS59=""
QUIT
Begin DoDot:1
+17 ; Patient Name
+18 SET BPSPT=$$GET1^DIQ(9002313.59,BPS59,5)
+19 ; Billable=0 Non-Billable=1
+20 SET BPSBILL=$$NB^BPSSCR03(BPS59)
+21 IF BPSBILL=0
Begin DoDot:2
+22 SET BPARR1(1,BPSPT,BPS59)=BPARR(BPS59)
+23 SET BPSCNT=BPSCNT+1
End DoDot:2
QUIT
+24 ; Only Non-Billable Claims at this point
+25 ; Open=0 Closed=1
+26 SET BPSOPNCLO=$$NBCL^BPSSCR03(BPS59)
+27 IF BPSOPNCLO=0
Begin DoDot:2
+28 SET BPARR1(2,BPSPT,BPS59)=BPARR(BPS59)
+29 SET BPSOPN=BPSOPN+1
End DoDot:2
QUIT
+30 SET BPARR1(3,BPSPT,BPS59)=BPARR(BPS59)
+31 SET BPSCLO=BPSCLO+1
End DoDot:1
+32 QUIT BPSCNT_"^"_BPSOPN_"^"_BPSCLO
