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

BPSSCRN0.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. OC ; entry point for open/close non-billable entry action
  1.  N BPRET,BP59,CLTOOP,JJ1,JJ2,JJ3,DFN,BPSSCRLN,BLN,COMMENT,BPQ,DIE,DA,DR,X,Y
  1.  N BPRET1,BPSARR59,BPSARR59A
  1.  D FULL^VALM1
  1.  W "Open/Close Non-Billable Entry"
  1.  W !,"Enter the line numbers for the entry/entries to be opened or closed."
  1.  S BPRET=$$ASKLINES^BPSSCRU4("Select items","C",.BPSARR59,VALMAR)
  1.  I BPRET="^" G OCX
  1.  ; Sort chosen entries
  1.  ; BPRET1= # of Billable Claims^# of Open (Non-Billable) Claims^# of Closed (NB) Claims
  1.  S BPRET1=$$OCNARR(.BPSARR59,.BPSARR59A)
  1.  I $P(BPRET1,"^",2)+$P(BPRET1,"^",3)=0 D  G OCX
  1.  . W !!,"The selected entries must be Non-Billable. Please try again."
  1.  . D PAUSE^VALM1
  1.  ;
  1.  ; Display Billable claims that will not be included.
  1.  I $P(BPRET1,"^")'=0 D  I BPQ="^" G OCX
  1.  . W !!,"Selected entries must be Non-Billable."
  1.  . W !,"The following entries are not Non-Billable and will not be included for"
  1.  . S BPSPT=""
  1.  . S BPQ=""
  1.  . F  S BPSPT=$O(BPSARR59A(1,BPSPT)) Q:BPSPT=""  D  Q:BPQ="^"
  1.  . . W !,BPSPT," :"
  1.  . . S BPS59=""
  1.  . . F  S BPS59=$O(BPSARR59A(1,BPSPT,BPS59)) Q:BPS59=""  D  Q:BPQ="^"
  1.  . . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
  1.  . . . W !,@VALMAR@(+$G(BPSARR59A(1,BPSPT,BPS59)),0)
  1.  . . . D DISPREJ^BPSSCRU6(BPS59)
  1.  ;
  1.  ; Display open claims to be closed.
  1.  I $P(BPRET1,"^",2)'=0 D  I BPQ="^" G OCX
  1.  . W !!,"You've chosen to CLOSE the following prescription(s) for"
  1.  . S BPSPT=""
  1.  . S BPQ=""
  1.  . F  S BPSPT=$O(BPSARR59A(2,BPSPT)) Q:BPSPT=""  D  Q:BPQ="^"
  1.  . . W !,BPSPT," :"
  1.  . . S BPS59=""
  1.  . . F  S BPS59=$O(BPSARR59A(2,BPSPT,BPS59)) Q:BPS59=""  D  Q:BPQ="^"
  1.  . . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
  1.  . . . W !,@VALMAR@(+$G(BPSARR59A(2,BPSPT,BPS59)),0)
  1.  . . . D DISPREJ^BPSSCRU6(BPS59)
  1.  ;
  1.  ;Display closed claims to be opened.
  1.  I $P(BPRET1,"^",3)'=0 D  I BPQ="^" G OCX
  1.  . W !!,"You've chosen to OPEN the following prescription(s) for"
  1.  . S BPSPT=""
  1.  . S BPQ=""
  1.  . F  S BPSPT=$O(BPSARR59A(3,BPSPT)) Q:BPSPT=""  D  Q:BPQ="^"
  1.  . . W !,BPSPT," :"
  1.  . . S BPS59=""
  1.  . . F  S BPS59=$O(BPSARR59A(3,BPSPT,BPS59)) Q:BPS59=""  D  Q:BPQ="^"
  1.  . . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
  1.  . . . W !,@VALMAR@(+$G(BPSARR59A(3,BPSPT,BPS59)),0)
  1.  . . . D DISPREJ^BPSSCRU6(BPS59)
  1.  ;
  1.  S BPSPRMPT=""
  1.  I $P(BPRET1,"^",3)'=0,$P(BPRET1,"^",2)=0 S BPSPRMPT="OPENED"
  1.  I $P(BPRET1,"^",2)'=0,$P(BPRET1,"^",3)=0 S BPSPRMPT="CLOSED"
  1.  I $P(BPRET1,"^",2)'=0,$P(BPRET1,"^",3)'=0 S BPSPRMPT="OPENED/CLOSED"
  1.  ;
  1.  W !!,"ALL Selected Non-Billable Rxs will be "_BPSPRMPT_" using the"
  1.  W !,"same information gathered in the following prompt.",!
  1.  ;
  1. COMQ ; capture the free text comments
  1.  S COMMENT=$$COMMENT^BPSSCRCL("Comment ",40)
  1.  I COMMENT=U W !!,"No changes made." D PAUSE^VALM1 G OCX
  1.  S COMMENT=$$TRIM^XLFSTR(COMMENT)     ; remove leading or trailing spaces
  1.  I '$L(COMMENT) W $C(7),!,"This is a required response. Enter '^' to exit" G COMQ
  1.  ;
  1.  S BPQ=$$YESNO^BPSSCRRS("Are you sure? (Y/N)")
  1.  I BPQ'=1 W !!,"No changes made." D PAUSE^VALM1 G OCX
  1.  ;
  1.  ; time to file
  1.  S DIE=9002313.59
  1.  ;
  1.  ; Loop through closed claims to be re-opened.
  1.  I $P(BPRET1,"^",3)'=0 D
  1.  . S BPSPT=""
  1.  . F  S BPSPT=$O(BPSARR59A(3,BPSPT)) Q:BPSPT=""  D
  1.  . . S DA=""
  1.  . . F  S DA=$O(BPSARR59A(3,BPSPT,DA)) Q:DA=""  D
  1.  . . . S DR="302////0;306////"_$$NOW^XLFDT
  1.  . . . S DR=DR_";307////^S X=DUZ;308////^S X=COMMENT"
  1.  . . . D ^DIE
  1.  ;
  1.  ; Loop through open claims to be closed.
  1.  I $P(BPRET1,"^",2)'=0 D
  1.  . S BPSPT=""
  1.  . F  S BPSPT=$O(BPSARR59A(2,BPSPT)) Q:BPSPT=""  D
  1.  . . S DA=""
  1.  . . F  S DA=$O(BPSARR59A(2,BPSPT,DA)) Q:DA=""  D 
  1.  . . . S DR="302////1;303////"_$$NOW^XLFDT
  1.  . . . S DR=DR_";304////^S X=DUZ;305////^S X=COMMENT"
  1.  . . . D ^DIE
  1.  ;
  1.  D PAUSE^VALM1
  1.  D REDRAW^BPSSCRUD("Updating screen ...")
  1.  ;
  1. OCX ;
  1.  I $G(BPQ)="^" D
  1.  . W !,"0 claims have been opened/closed."
  1.  . D PAUSE^VALM1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. OCNARR(BPARR,BPARR1) ; Re-sort array of user selected claims
  1.  ; The user selected claims will be re-sorted, dividing them by
  1.  ; Billable Claims, Non-Billable Open Claims and NB Closed Claims.
  1.  ; The claims will also be sorted, within each grouping, alphabetically
  1.  ; by Patient Name.
  1.  ; BPARR - input - array of user selected claims
  1.  ; BPARR1 - output - array of user selected claims; re-sorted
  1.  ; BPARR1(1,PATIENT,BPS TRANSACTION) = Billable Claims
  1.  ; BPARR1(2,PATIENT,BPS TRANSACTION) = Non-Billable Open Claims
  1.  ; BPARR1(3,PATIENT,BPS TRANSACTION) = Non-Billable Closed Claims
  1.  ; Function Return Value = Counts of each category from BPARR1
  1.  ;  # of Billable Claims^# of Open NB Claims^# of Closed NB Claims
  1.  ;
  1.  N BPS59,BPSCLO,BPSCNT,BPSOPN,BPSPT,BPSBILL
  1.  S BPSCNT=0,BPSOPN=0,BPSCLO=0
  1.  S BPS59=""
  1.  F  S BPS59=$O(BPARR(BPS59)) Q:BPS59=""  D
  1.  . ; Patient Name
  1.  . S BPSPT=$$GET1^DIQ(9002313.59,BPS59,5)
  1.  . ; Billable=0 Non-Billable=1
  1.  . S BPSBILL=$$NB^BPSSCR03(BPS59)
  1.  . I BPSBILL=0 D  Q
  1.  . . S BPARR1(1,BPSPT,BPS59)=BPARR(BPS59)
  1.  . . S BPSCNT=BPSCNT+1
  1.  . ; Only Non-Billable Claims at this point
  1.  . ; Open=0 Closed=1
  1.  . S BPSOPNCLO=$$NBCL^BPSSCR03(BPS59)
  1.  . I BPSOPNCLO=0 D  Q
  1.  . . S BPARR1(2,BPSPT,BPS59)=BPARR(BPS59)
  1.  . . S BPSOPN=BPSOPN+1
  1.  . S BPARR1(3,BPSPT,BPS59)=BPARR(BPS59)
  1.  . S BPSCLO=BPSCLO+1
  1.  Q BPSCNT_"^"_BPSOPN_"^"_BPSCLO