RCHRFS ;SLC/SS - High Risk for Suicide Patients Report ; JAN 22,2021@14:32
;;4.5;Accounts Receivable;**379**;Mar 20, 1995;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
;
;External References Type ICR #
;------------------- ----------- -----
; HOME^%ZIS Supported 10086
; ^%ZISC Supported 10089
; $$S^%ZTLOAD Supported 10063
; $$GETFLAG^DGPFAPIU Contr. Sub. 5491
; ^DIC Supported 10006
; WAIT^DICD Supported 10024
; RECALL^DILFD Supported 2055
; ^DIR Supported 10026
; $$SITE^VASITE Supported 10112
; $$FMTE^XLFDT Supported 10103
; $$NOW^XLFDT Supported 10103
; $$CJ^XLFSTR Supported 10104
; EN^XUTMDEVQ Supported 1519
;
;Access to files
; ICR# TYPE Description
;----- ----------- --------------------------------------------------------------------
; 7229 Controlled File (#26.13) access to the "C" cross-reference for patient look-up.
;
;Global References Supported by
;----------------- --------------
; ^TMP($J SACC 2.3.2.5.1
;
;No direct call
Q
;
;Entry point for PRCA HRFS RECONCILIATION RPT
MAIN ; Initial Interactive Processing
N RCPATMOD,RCEXLOOP,RCEXPRG,RCZZ
N RCSORT ;array of report parameters for ZTSAVE
W @IOF
N ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,%ZIS
;check for database
W "*** CPAC High Risk Veteran Reconciliation Report *** "
W !!,"This report captures detailed 1st party bill information for Veterans"
W !,"with a High Risk for Suicide flag (HRfS) within a user specified range of"
W !,"dates of service. This report can be run for a single Veteran or all Veterans."
W !,"This report output requires screen size of 256 characters wide."
W !
; select the mode
S RCSORT=""
S RCPATMOD=$$YESNO("Do you want to run the report for ALL Veterans","YES")
; quit if no answer
I RCPATMOD<0 Q
;if "ALL then set RCSORT to ALL
S RCSORT=$S(RCPATMOD=1:"ALL",1:"")
;select the patient if single patient mode:
I RCPATMOD=0 Q:'$$PROMPTPT(.RCSORT) Q:RCSORT<1 D RECALL^DILFD(2,+RCSORT_",",DUZ)
;Prompt user for the start date and end dates
S RCEXLOOP=0,RCEXPRG=0
F D Q:RCEXLOOP=1
.N RCZ,RCZ2
.W !
.S RCZ=$$ASKDATE("Enter From Date: ",,DT,,"^D HELP^RCHRFS(1)")
.I RCZ'>0 S RCEXLOOP=1,RCEXPRG=1 Q
.S RCSORT("RCBEG")=RCZ
.;Prompt user for TO Date of Eligibility Change
.S RCZ=$$ASKDATE("Enter To Date: ",RCSORT("RCBEG"),DT,"TODAY","^D HELP^RCHRFS(2,"_RCSORT("RCBEG")_")")
.I RCZ'>0 S RCEXLOOP=1,RCEXPRG=1 Q
.S RCSORT("RCEND")=RCZ
.;if ALL patients mode then do not check for HRfS for the range and ask only once
.I RCSORT="ALL" S RCEXLOOP=1 Q
.;if single patient mode then check the HRfS for the range and ask for dates again if necessary
.S RCZ2=$$HASHRFS^RCHRFSUT(RCSORT,RCSORT("RCBEG"),RCSORT("RCEND"))
.I RCZ2=0 W !!,"Veteran's HRfS flag was not active during the selected date range.",!,"Please enter a new date range.",! Q
.S RCEXLOOP=1
.W !
;if the user wanted to quit at the date prompts
I RCEXPRG=1 Q
;Select copay type
S RCZZ=$$SELCOTYP(3)
I RCZZ="^" Q
S RCSORT("COPAYTYPE")=RCZZ
;Select IB status
S RCZZ=$$SELIBST(5)
I RCZZ="^" Q
S RCSORT("IBSTATUS")=RCZZ
;prompt for device
W !!,"The number of characters per row should be set to 256.",!
W !,"Please use the following path to modify the display settings:"
W !,"In Reflections. File >>> Terminal Configuration >>> "
W !,"Setup Display Setting >>> Number of characters per row.",!
W !,"To capture as a spreadsheet format, it is recommended that you"
W !,"enter the following at the DEVICE prompt: 0;256;99999."
W !,"This should help avoid wrapping problems.",!
W !,"For pagination, please use "";256;"" for the device value instead of the default.",!
;
;set the prompt and run the report in background
PRMPT ;
S %ZIS=""
S %ZIS("B")="0;256;99999"
S ZTSAVE("RCSORT(")=""
S X="CPAC High Risk Veteran Reconciliation Report"
D EN^XUTMDEVQ("START^RCHRFS",X,.ZTSAVE,.%ZIS)
D HOME^%ZIS
Q
;
START ; compile and print report
I $E(IOST)="C" D WAIT^DICD
N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name where the report is run
N TRM S TRM=($E(IOST)="C")
D REPORT(.RCSORT)
I '$G(IBQUIT) D ASKCONT(0)
D EXIT
Q
;
;Main entry point for report body
REPORT(RCSORT) ;
N DDASH,RCPAGE,RCDFN,DATA,SORTENCBY,RCREF,RCFL
S $P(DDASH,"=",81)=""
S (RCPAGE,SORTENCBY)=0
;
I RCSORT="ALL" D
. S RCREF=$$GETFLAG^DGPFAPIU("HIGH RISK FOR SUICIDE","N")
. S RCDFN=0
. F S RCDFN=$O(^DGPF(26.13,"C",RCDFN)) Q:'RCDFN D
.. S RCFL=""
.. F S RCFL=$O(^DGPF(26.13,"C",RCDFN,RCFL)) Q:'RCFL I RCFL=RCREF D
... D RUNRPT^RCHRFS1(+RCDFN,RCSORT("RCBEG"),RCSORT("RCEND"),+RCSORT("IBSTATUS"),+RCSORT("COPAYTYPE"))
;
I RCSORT>0 D RUNRPT^RCHRFS1(+RCSORT,RCSORT("RCBEG"),RCSORT("RCEND"),+RCSORT("IBSTATUS"),+RCSORT("COPAYTYPE"))
;
;No data found , display message and quit
I '$D(^TMP($J,"RCHRFS")) S POP=1 D Q
. D HEADER,COLHEAD
. W !!!," >>> No records were found in the selected date range.",!!
;
;I data was found then do the rest
S TRM=1
S IBQUIT=0
;
D HEADER,COLHEAD
D OUTPRPT^RCHRFS1
Q
;
N RCHRFSDT
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 Q
I TRM!('TRM&RCPAGE) W @IOF
S RCPAGE=$G(RCPAGE)+1
S RCHRFSDT=$$HRFSDATE^RCHRFSUT()
W !,$G(ZTDESC)
W !,"Legislation Date: "_$S(RCHRFSDT="":"TBD",1:$$FMTE^XLFDT(RCHRFSDT,"5Z"))
W !,"Run date: ",$$FMTE^XLFDT($$NOW^XLFDT,"MP")
W !,"Service Dates From ",?12,$$FMTE^XLFDT(RCSORT("RCBEG"),"5Z")_" To "_$$FMTE^XLFDT(RCSORT("RCEND"),"5Z")
W !,"Copay Type Selected: "_$P(RCSORT("COPAYTYPE"),U,2)
W !,"IB Status Selected: "_$P(RCSORT("IBSTATUS"),U,2)
W !
Q
;
ASKCONT(FLAG) ; display "press <Enter> to continue" prompt
N Z
W !!,$$CJ^XLFSTR("Press <Enter> to "_$S(FLAG=1:"continue.",1:"exit."),20)
R !,Z:DTIME
Q
;
;
;------PRCA 393 utilities ------------------------------------------
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@" ;tell TaskMan to delete Task log entry
I '$D(ZTQUEUED) D
. I 'TRM,$Y>0 W @IOF
. K %ZIS,POP
. D ^%ZISC,HOME^%ZIS
Q
;
;
; Ask Yes/No questions
; Input:
; PROMPT - question
; DFLANSW - default answer
; Output:
; 1 YES
; 0 NO
; -1 if cancelled
YESNO(PROMPT,DFLANSW) ;
N DIR
N DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="Y"
I $G(PROMPT)'="" S DIR("A")=PROMPT
S:$L($G(DFLANSW)) DIR("B")=DFLANSW
S DIR("?")="ENTER Y(ES) OR N(O)"
D ^DIR
Q $S($G(DUOUT)!$G(DUOUT)!(Y="^"):-1,1:Y)
;
;prompt for FROM and TO dates
; RCDIRA - prompt
; RCBEGDT - default date in FM format
ASKDATE(RCPROMPT,RCMINDT,RCMAXDT,RCDFLANS,RCHELP) ;
N RCASK,RCDIRO
S RCMINDT=$G(RCMINDT)
S RCMAXDT=$G(RCMAXDT)
S RCDFLANS=$G(RCDFLANS)
I RCDFLANS="" I RCMINDT>0 S RCDFLANS=$$FMTE^XLFDT(RCMINDT)
S RCDIRO="DAO^"_RCMINDT_":"_RCMAXDT_":EX"
S RCASK=$$ANSWER(RCPROMPT,RCDFLANS,RCDIRO,RCHELP)
Q RCASK
;
;Generic code to ask questions
ANSWER(RCDIRA,RCDIRB,RCDIR0,RCDIRH) ;
; Input
; RCDIR0 - DIR(0) string
; RCDIRA - DIR("A") string
; RCDIRB - DIR("B") string
; RCDIRH - DIR("?") string
; Output
; Function Value - Internal value returned from ^DIR or -1 if user
; up-arrows, double up-arrows or the read times out.
N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
I $D(RCDIR0) S DIR(0)=RCDIR0
I $D(RCDIRA) M DIR("A")=RCDIRA
I $G(RCDIRB)]"" S DIR("B")=RCDIRB
I $D(RCDIRH) S DIR("?")=RCDIRH,DIR("??")=RCDIRH
D ^DIR K DIR
S Z=$S($D(DTOUT):-2,$D(DUOUT):-1,$D(DIROUT):-1,1:"")
I Z="" S Z=$S(Y=-1:"",X="@":"@",1:$P(Y,U)) Q Z
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
Q $S(X="@":"@",1:$P(Y,U))
;
;provide extended DIR("?") help text.
HELP(RCSEL,RCFRDT) ;
; Input: RCSEL - prompt var for help text word selection
; Output: none
I (X="?")!(X="??") D Q
. I RCSEL=1 D
. . W !," Enter the FROM date"
. I $D(Y) K Y
. I RCSEL=2 D
. . W !," Enter the TO date"
. I $D(Y) K Y
I $D(Y),Y<1 D HELP1 I $D(Y) K Y Q
I $D(Y),Y>DT D HELP2 I $D(Y) K Y Q
I $D(Y),Y<$G(RCFRDT) D HELP3 I $D(Y) K Y Q
Q
;
HELP1 ;
W !," Invalid Date"
Q
;
HELP2 ;
W !," Date cannot be a future date."
Q
;
HELP3 ;
W !," Date cannot be earlier than the From date."
Q
;
;select copay type
SELCOTYP(DFLT) ;
;Return Value ->
; 1 Medical Care"
; 2 Outpatient Medication"
; 3 Both (Medical Care and Outpatient Medication)"
; ^ Exit
N DIR,DIRUT,DTOUT,DUOUT,X,Y
W !!,"Which type of copayment do you wish to see?"
S DIR(0)="S^1:Medical Care;2:Outpatient Medication;3:Both (Medical Care and Outpatient Medication)"
S DIR("A")="Enter selection (1,2 or 3)"
S DIR("B")=DFLT
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" 1 Medical Care"
S DIR("L",4)=" 2 Outpatient Medication"
S DIR("L",5)=" 3 Both (Medical Care and Outpatient Medication)"
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
I Y="^" Q Y
Q Y_U_Y(0)
;
;
;select copay type
SELIBST(DFLT) ;
;Return Value ->
; 1 Medical Care"
; 2 Outpatient Medication"
; 3 Both (Medical Care and Outpatient Medication)"
; ^ Exit
N DIR,DIRUT,DTOUT,DUOUT,X,Y
W !!,"Which IB status for the selected copayment(s) do you wish to see?"
S DIR(0)="S^1:Billed;2:On Hold;3:Cancelled;4:Billed and On Hold;5:ALL (Billed, On Hold, Cancelled)"
S DIR("A")="Enter Status selection (1,2,3,4 or 5)"
S DIR("B")=DFLT
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" 1 Billed"
S DIR("L",4)=" 2 On Hold"
S DIR("L",5)=" 3 Cancelled"
S DIR("L",6)=" 4 Billed and On Hold"
S DIR("L",7)=" 5 ALL (Billed, On Hold, Cancelled)"
D ^DIR
I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^"
I Y="^" Q Y
Q Y_U_Y(0)
;
;select the patient
PROMPTPT(RCSORT) ;
N RCHRFSFL,RCLOOP,RCPTNM
S RCLOOP=0
;keep prompting for patient name
F D Q:RCLOOP
. ;Prompt user for patient name
. S RCPTNM=$$SELPAT(.RCSORT)
. I +RCSORT'>0 S RCLOOP=1 Q
. S RCHRFSFL=$$HRFSINFO^RCHRFSUT(RCSORT) ;check if this patient has HRfS flag at all
. I RCHRFSFL<1 D Q
. . W !!," The Veteran does not have a HRfS flag on file."
. . W !," Please enter another Veteran.",!!
. S RCLOOP=1
Q RCLOOP
;
;prompt for veteran's name
SELPAT(RCSORT) ;prompt for veteran's name
;- input vars for ^DIC call
N DIC,DTOUT,DUOUT,X,Y
S DIC="^DPT(",DIC(0)="AEMQZV"
S DIC("A")="Enter Veteran Name: "
S DIC("?PARAM",2,"INDEX")="B"
;- lookup patient
D ^DIC K DIC
;- result of lookup
S RCSORT=Y
;- if success, setup return array using output vars from ^DIC call
I (+RCSORT>0) D Q Y(0,0) ;patient name
. S RCSORT=+Y ;patient ien
. S RCSORT(0)=$G(Y(0)) ;zero node of patient in (#2) file
Q -1
;
COLHEAD ;report column header
W !
W "Veteran Name"
W ?26,"^SSN"
W ?36,"^HRfS Active Date"
W ?53,"^HRfS Inactive Date"
W ?72,"^HRfS Active"
W ?84,"^Bill Number"
W ?96,"^Category"
W ?123,"^Medical DOS"
W ?135,"^Rx Fill Date"
W ?148,"^Rx Release Date"
W ?164,"^Rx Number"
W ?177,"^Rx Name"
W ?194,"^Charge"
W ?206,"^Unit"
W ?211,"^IB Status"
W ?225,"^AR Status"
W !
W ""
W ?26,"^"
W ?36,"^"
W ?53,"^"
W ?72,"^On DOS"
W ?84,"^"
W ?96,"^"
W ?123,"^"
W ?135,"^"
W ?148,"^"
W ?164,"^"
W ?177,"^"
W ?194,"^Amount"
W ?206,"^Day"
W ?211,"^"
W ?225,"^"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCHRFS 11686 printed Sep 23, 2025@19:23:08 Page 2
RCHRFS ;SLC/SS - High Risk for Suicide Patients Report ; JAN 22,2021@14:32
+1 ;;4.5;Accounts Receivable;**379**;Mar 20, 1995;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 ;External References Type ICR #
+6 ;------------------- ----------- -----
+7 ; HOME^%ZIS Supported 10086
+8 ; ^%ZISC Supported 10089
+9 ; $$S^%ZTLOAD Supported 10063
+10 ; $$GETFLAG^DGPFAPIU Contr. Sub. 5491
+11 ; ^DIC Supported 10006
+12 ; WAIT^DICD Supported 10024
+13 ; RECALL^DILFD Supported 2055
+14 ; ^DIR Supported 10026
+15 ; $$SITE^VASITE Supported 10112
+16 ; $$FMTE^XLFDT Supported 10103
+17 ; $$NOW^XLFDT Supported 10103
+18 ; $$CJ^XLFSTR Supported 10104
+19 ; EN^XUTMDEVQ Supported 1519
+20 ;
+21 ;Access to files
+22 ; ICR# TYPE Description
+23 ;----- ----------- --------------------------------------------------------------------
+24 ; 7229 Controlled File (#26.13) access to the "C" cross-reference for patient look-up.
+25 ;
+26 ;Global References Supported by
+27 ;----------------- --------------
+28 ; ^TMP($J SACC 2.3.2.5.1
+29 ;
+30 ;No direct call
+31 QUIT
+32 ;
+33 ;Entry point for PRCA HRFS RECONCILIATION RPT
MAIN ; Initial Interactive Processing
+1 NEW RCPATMOD,RCEXLOOP,RCEXPRG,RCZZ
+2 ;array of report parameters for ZTSAVE
NEW RCSORT
+3 WRITE @IOF
+4 NEW ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,%ZIS
+5 ;check for database
+6 WRITE "*** CPAC High Risk Veteran Reconciliation Report *** "
+7 WRITE !!,"This report captures detailed 1st party bill information for Veterans"
+8 WRITE !,"with a High Risk for Suicide flag (HRfS) within a user specified range of"
+9 WRITE !,"dates of service. This report can be run for a single Veteran or all Veterans."
+10 WRITE !,"This report output requires screen size of 256 characters wide."
+11 WRITE !
+12 ; select the mode
+13 SET RCSORT=""
+14 SET RCPATMOD=$$YESNO("Do you want to run the report for ALL Veterans","YES")
+15 ; quit if no answer
+16 IF RCPATMOD<0
QUIT
+17 ;if "ALL then set RCSORT to ALL
+18 SET RCSORT=$SELECT(RCPATMOD=1:"ALL",1:"")
+19 ;select the patient if single patient mode:
+20 IF RCPATMOD=0
if '$$PROMPTPT(.RCSORT)
QUIT
if RCSORT<1
QUIT
DO RECALL^DILFD(2,+RCSORT_",",DUZ)
+21 ;Prompt user for the start date and end dates
+22 SET RCEXLOOP=0
SET RCEXPRG=0
+23 FOR
Begin DoDot:1
+24 NEW RCZ,RCZ2
+25 WRITE !
+26 SET RCZ=$$ASKDATE("Enter From Date: ",,DT,,"^D HELP^RCHRFS(1)")
+27 IF RCZ'>0
SET RCEXLOOP=1
SET RCEXPRG=1
QUIT
+28 SET RCSORT("RCBEG")=RCZ
+29 ;Prompt user for TO Date of Eligibility Change
+30 SET RCZ=$$ASKDATE("Enter To Date: ",RCSORT("RCBEG"),DT,"TODAY","^D HELP^RCHRFS(2,"_RCSORT("RCBEG")_")")
+31 IF RCZ'>0
SET RCEXLOOP=1
SET RCEXPRG=1
QUIT
+32 SET RCSORT("RCEND")=RCZ
+33 ;if ALL patients mode then do not check for HRfS for the range and ask only once
+34 IF RCSORT="ALL"
SET RCEXLOOP=1
QUIT
+35 ;if single patient mode then check the HRfS for the range and ask for dates again if necessary
+36 SET RCZ2=$$HASHRFS^RCHRFSUT(RCSORT,RCSORT("RCBEG"),RCSORT("RCEND"))
+37 IF RCZ2=0
WRITE !!,"Veteran's HRfS flag was not active during the selected date range.",!,"Please enter a new date range.",!
QUIT
+38 SET RCEXLOOP=1
+39 WRITE !
End DoDot:1
if RCEXLOOP=1
QUIT
+40 ;if the user wanted to quit at the date prompts
+41 IF RCEXPRG=1
QUIT
+42 ;Select copay type
+43 SET RCZZ=$$SELCOTYP(3)
+44 IF RCZZ="^"
QUIT
+45 SET RCSORT("COPAYTYPE")=RCZZ
+46 ;Select IB status
+47 SET RCZZ=$$SELIBST(5)
+48 IF RCZZ="^"
QUIT
+49 SET RCSORT("IBSTATUS")=RCZZ
+50 ;prompt for device
+51 WRITE !!,"The number of characters per row should be set to 256.",!
+52 WRITE !,"Please use the following path to modify the display settings:"
+53 WRITE !,"In Reflections. File >>> Terminal Configuration >>> "
+54 WRITE !,"Setup Display Setting >>> Number of characters per row.",!
+55 WRITE !,"To capture as a spreadsheet format, it is recommended that you"
+56 WRITE !,"enter the following at the DEVICE prompt: 0;256;99999."
+57 WRITE !,"This should help avoid wrapping problems.",!
+58 WRITE !,"For pagination, please use "";256;"" for the device value instead of the default.",!
+59 ;
+60 ;set the prompt and run the report in background
PRMPT ;
+1 SET %ZIS=""
+2 SET %ZIS("B")="0;256;99999"
+3 SET ZTSAVE("RCSORT(")=""
+4 SET X="CPAC High Risk Veteran Reconciliation Report"
+5 DO EN^XUTMDEVQ("START^RCHRFS",X,.ZTSAVE,.%ZIS)
+6 DO HOME^%ZIS
+7 QUIT
+8 ;
START ; compile and print report
+1 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+2 ;extract the IEN and facility name where the report is run
NEW HERE
SET HERE=$$SITE^VASITE
+3 NEW TRM
SET TRM=($EXTRACT(IOST)="C")
+4 DO REPORT(.RCSORT)
+5 IF '$GET(IBQUIT)
DO ASKCONT(0)
+6 DO EXIT
+7 QUIT
+8 ;
+9 ;Main entry point for report body
REPORT(RCSORT) ;
+1 NEW DDASH,RCPAGE,RCDFN,DATA,SORTENCBY,RCREF,RCFL
+2 SET $PIECE(DDASH,"=",81)=""
+3 SET (RCPAGE,SORTENCBY)=0
+4 ;
+5 IF RCSORT="ALL"
Begin DoDot:1
+6 SET RCREF=$$GETFLAG^DGPFAPIU("HIGH RISK FOR SUICIDE","N")
+7 SET RCDFN=0
+8 FOR
SET RCDFN=$ORDER(^DGPF(26.13,"C",RCDFN))
if 'RCDFN
QUIT
Begin DoDot:2
+9 SET RCFL=""
+10 FOR
SET RCFL=$ORDER(^DGPF(26.13,"C",RCDFN,RCFL))
if 'RCFL
QUIT
IF RCFL=RCREF
Begin DoDot:3
+11 DO RUNRPT^RCHRFS1(+RCDFN,RCSORT("RCBEG"),RCSORT("RCEND"),+RCSORT("IBSTATUS"),+RCSORT("COPAYTYPE"))
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 IF RCSORT>0
DO RUNRPT^RCHRFS1(+RCSORT,RCSORT("RCBEG"),RCSORT("RCEND"),+RCSORT("IBSTATUS"),+RCSORT("COPAYTYPE"))
+14 ;
+15 ;No data found , display message and quit
+16 IF '$DATA(^TMP($JOB,"RCHRFS"))
SET POP=1
Begin DoDot:1
+17 DO HEADER
DO COLHEAD
+18 WRITE !!!," >>> No records were found in the selected date range.",!!
End DoDot:1
QUIT
+19 ;
+20 ;I data was found then do the rest
+21 SET TRM=1
+22 SET IBQUIT=0
+23 ;
+24 DO HEADER
DO COLHEAD
+25 DO OUTPRPT^RCHRFS1
+26 QUIT
+27 ;
+1 NEW RCHRFSDT
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
QUIT
+3 IF TRM!('TRM&RCPAGE)
WRITE @IOF
+4 SET RCPAGE=$GET(RCPAGE)+1
+5 SET RCHRFSDT=$$HRFSDATE^RCHRFSUT()
+6 WRITE !,$GET(ZTDESC)
+7 WRITE !,"Legislation Date: "_$SELECT(RCHRFSDT="":"TBD",1:$$FMTE^XLFDT(RCHRFSDT,"5Z"))
+8 WRITE !,"Run date: ",$$FMTE^XLFDT($$NOW^XLFDT,"MP")
+9 WRITE !,"Service Dates From ",?12,$$FMTE^XLFDT(RCSORT("RCBEG"),"5Z")_" To "_$$FMTE^XLFDT(RCSORT("RCEND"),"5Z")
+10 WRITE !,"Copay Type Selected: "_$PIECE(RCSORT("COPAYTYPE"),U,2)
+11 WRITE !,"IB Status Selected: "_$PIECE(RCSORT("IBSTATUS"),U,2)
+12 WRITE !
+13 QUIT
+14 ;
ASKCONT(FLAG) ; display "press <Enter> to continue" prompt
+1 NEW Z
+2 WRITE !!,$$CJ^XLFSTR("Press <Enter> to "_$SELECT(FLAG=1:"continue.",1:"exit."),20)
+3 READ !,Z:DTIME
+4 QUIT
+5 ;
+6 ;
+7 ;------PRCA 393 utilities ------------------------------------------
EXIT ;
+1 ;tell TaskMan to delete Task log entry
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 IF 'TRM
IF $Y>0
WRITE @IOF
+4 KILL %ZIS,POP
+5 DO ^%ZISC
DO HOME^%ZIS
End DoDot:1
+6 QUIT
+7 ;
+8 ;
+9 ; Ask Yes/No questions
+10 ; Input:
+11 ; PROMPT - question
+12 ; DFLANSW - default answer
+13 ; Output:
+14 ; 1 YES
+15 ; 0 NO
+16 ; -1 if cancelled
YESNO(PROMPT,DFLANSW) ;
+1 NEW DIR
+2 NEW DTOUT,DUOUT,DIRUT,DIROUT
+3 SET DIR(0)="Y"
+4 IF $GET(PROMPT)'=""
SET DIR("A")=PROMPT
+5 if $LENGTH($GET(DFLANSW))
SET DIR("B")=DFLANSW
+6 SET DIR("?")="ENTER Y(ES) OR N(O)"
+7 DO ^DIR
+8 QUIT $SELECT($GET(DUOUT)!$GET(DUOUT)!(Y="^"):-1,1:Y)
+9 ;
+10 ;prompt for FROM and TO dates
+11 ; RCDIRA - prompt
+12 ; RCBEGDT - default date in FM format
ASKDATE(RCPROMPT,RCMINDT,RCMAXDT,RCDFLANS,RCHELP) ;
+1 NEW RCASK,RCDIRO
+2 SET RCMINDT=$GET(RCMINDT)
+3 SET RCMAXDT=$GET(RCMAXDT)
+4 SET RCDFLANS=$GET(RCDFLANS)
+5 IF RCDFLANS=""
IF RCMINDT>0
SET RCDFLANS=$$FMTE^XLFDT(RCMINDT)
+6 SET RCDIRO="DAO^"_RCMINDT_":"_RCMAXDT_":EX"
+7 SET RCASK=$$ANSWER(RCPROMPT,RCDFLANS,RCDIRO,RCHELP)
+8 QUIT RCASK
+9 ;
+10 ;Generic code to ask questions
ANSWER(RCDIRA,RCDIRB,RCDIR0,RCDIRH) ;
+1 ; Input
+2 ; RCDIR0 - DIR(0) string
+3 ; RCDIRA - DIR("A") string
+4 ; RCDIRB - DIR("B") string
+5 ; RCDIRH - DIR("?") string
+6 ; Output
+7 ; Function Value - Internal value returned from ^DIR or -1 if user
+8 ; up-arrows, double up-arrows or the read times out.
+9 NEW X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
+10 IF $DATA(RCDIR0)
SET DIR(0)=RCDIR0
+11 IF $DATA(RCDIRA)
MERGE DIR("A")=RCDIRA
+12 IF $GET(RCDIRB)]""
SET DIR("B")=RCDIRB
+13 IF $DATA(RCDIRH)
SET DIR("?")=RCDIRH
SET DIR("??")=RCDIRH
+14 DO ^DIR
KILL DIR
+15 SET Z=$SELECT($DATA(DTOUT):-2,$DATA(DUOUT):-1,$DATA(DIROUT):-1,1:"")
+16 IF Z=""
SET Z=$SELECT(Y=-1:"",X="@":"@",1:$PIECE(Y,U))
QUIT Z
+17 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT -1
+18 QUIT $SELECT(X="@":"@",1:$PIECE(Y,U))
+19 ;
+20 ;provide extended DIR("?") help text.
HELP(RCSEL,RCFRDT) ;
+1 ; Input: RCSEL - prompt var for help text word selection
+2 ; Output: none
+3 IF (X="?")!(X="??")
Begin DoDot:1
+4 IF RCSEL=1
Begin DoDot:2
+5 WRITE !," Enter the FROM date"
End DoDot:2
+6 IF $DATA(Y)
KILL Y
+7 IF RCSEL=2
Begin DoDot:2
+8 WRITE !," Enter the TO date"
End DoDot:2
+9 IF $DATA(Y)
KILL Y
End DoDot:1
QUIT
+10 IF $DATA(Y)
IF Y<1
DO HELP1
IF $DATA(Y)
KILL Y
QUIT
+11 IF $DATA(Y)
IF Y>DT
DO HELP2
IF $DATA(Y)
KILL Y
QUIT
+12 IF $DATA(Y)
IF Y<$GET(RCFRDT)
DO HELP3
IF $DATA(Y)
KILL Y
QUIT
+13 QUIT
+14 ;
HELP1 ;
+1 WRITE !," Invalid Date"
+2 QUIT
+3 ;
HELP2 ;
+1 WRITE !," Date cannot be a future date."
+2 QUIT
+3 ;
HELP3 ;
+1 WRITE !," Date cannot be earlier than the From date."
+2 QUIT
+3 ;
+4 ;select copay type
SELCOTYP(DFLT) ;
+1 ;Return Value ->
+2 ; 1 Medical Care"
+3 ; 2 Outpatient Medication"
+4 ; 3 Both (Medical Care and Outpatient Medication)"
+5 ; ^ Exit
+6 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+7 WRITE !!,"Which type of copayment do you wish to see?"
+8 SET DIR(0)="S^1:Medical Care;2:Outpatient Medication;3:Both (Medical Care and Outpatient Medication)"
+9 SET DIR("A")="Enter selection (1,2 or 3)"
+10 SET DIR("B")=DFLT
+11 SET DIR("L",1)="Select one of the following:"
+12 SET DIR("L",2)=""
+13 SET DIR("L",3)=" 1 Medical Care"
+14 SET DIR("L",4)=" 2 Outpatient Medication"
+15 SET DIR("L",5)=" 3 Both (Medical Care and Outpatient Medication)"
+16 DO ^DIR
+17 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+18 IF Y="^"
QUIT Y
+19 QUIT Y_U_Y(0)
+20 ;
+21 ;
+22 ;select copay type
SELIBST(DFLT) ;
+1 ;Return Value ->
+2 ; 1 Medical Care"
+3 ; 2 Outpatient Medication"
+4 ; 3 Both (Medical Care and Outpatient Medication)"
+5 ; ^ Exit
+6 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+7 WRITE !!,"Which IB status for the selected copayment(s) do you wish to see?"
+8 SET DIR(0)="S^1:Billed;2:On Hold;3:Cancelled;4:Billed and On Hold;5:ALL (Billed, On Hold, Cancelled)"
+9 SET DIR("A")="Enter Status selection (1,2,3,4 or 5)"
+10 SET DIR("B")=DFLT
+11 SET DIR("L",1)="Select one of the following:"
+12 SET DIR("L",2)=""
+13 SET DIR("L",3)=" 1 Billed"
+14 SET DIR("L",4)=" 2 On Hold"
+15 SET DIR("L",5)=" 3 Cancelled"
+16 SET DIR("L",6)=" 4 Billed and On Hold"
+17 SET DIR("L",7)=" 5 ALL (Billed, On Hold, Cancelled)"
+18 DO ^DIR
+19 IF ($GET(DUOUT)=1)!($GET(DTOUT)=1)
SET Y="^"
+20 IF Y="^"
QUIT Y
+21 QUIT Y_U_Y(0)
+22 ;
+23 ;select the patient
PROMPTPT(RCSORT) ;
+1 NEW RCHRFSFL,RCLOOP,RCPTNM
+2 SET RCLOOP=0
+3 ;keep prompting for patient name
+4 FOR
Begin DoDot:1
+5 ;Prompt user for patient name
+6 SET RCPTNM=$$SELPAT(.RCSORT)
+7 IF +RCSORT'>0
SET RCLOOP=1
QUIT
+8 ;check if this patient has HRfS flag at all
SET RCHRFSFL=$$HRFSINFO^RCHRFSUT(RCSORT)
+9 IF RCHRFSFL<1
Begin DoDot:2
+10 WRITE !!," The Veteran does not have a HRfS flag on file."
+11 WRITE !," Please enter another Veteran.",!!
End DoDot:2
QUIT
+12 SET RCLOOP=1
End DoDot:1
if RCLOOP
QUIT
+13 QUIT RCLOOP
+14 ;
+15 ;prompt for veteran's name
SELPAT(RCSORT) ;prompt for veteran's name
+1 ;- input vars for ^DIC call
+2 NEW DIC,DTOUT,DUOUT,X,Y
+3 SET DIC="^DPT("
SET DIC(0)="AEMQZV"
+4 SET DIC("A")="Enter Veteran Name: "
+5 SET DIC("?PARAM",2,"INDEX")="B"
+6 ;- lookup patient
+7 DO ^DIC
KILL DIC
+8 ;- result of lookup
+9 SET RCSORT=Y
+10 ;- if success, setup return array using output vars from ^DIC call
+11 ;patient name
IF (+RCSORT>0)
Begin DoDot:1
+12 ;patient ien
SET RCSORT=+Y
+13 ;zero node of patient in (#2) file
SET RCSORT(0)=$GET(Y(0))
End DoDot:1
QUIT Y(0,0)
+14 QUIT -1
+15 ;
COLHEAD ;report column header
+1 WRITE !
+2 WRITE "Veteran Name"
+3 WRITE ?26,"^SSN"
+4 WRITE ?36,"^HRfS Active Date"
+5 WRITE ?53,"^HRfS Inactive Date"
+6 WRITE ?72,"^HRfS Active"
+7 WRITE ?84,"^Bill Number"
+8 WRITE ?96,"^Category"
+9 WRITE ?123,"^Medical DOS"
+10 WRITE ?135,"^Rx Fill Date"
+11 WRITE ?148,"^Rx Release Date"
+12 WRITE ?164,"^Rx Number"
+13 WRITE ?177,"^Rx Name"
+14 WRITE ?194,"^Charge"
+15 WRITE ?206,"^Unit"
+16 WRITE ?211,"^IB Status"
+17 WRITE ?225,"^AR Status"
+18 WRITE !
+19 WRITE ""
+20 WRITE ?26,"^"
+21 WRITE ?36,"^"
+22 WRITE ?53,"^"
+23 WRITE ?72,"^On DOS"
+24 WRITE ?84,"^"
+25 WRITE ?96,"^"
+26 WRITE ?123,"^"
+27 WRITE ?135,"^"
+28 WRITE ?148,"^"
+29 WRITE ?164,"^"
+30 WRITE ?177,"^"
+31 WRITE ?194,"^Amount"
+32 WRITE ?206,"^Day"
+33 WRITE ?211,"^"
+34 WRITE ?225,"^"
+35 QUIT
+36 ;
