DGOTHRPT ;SLC/RM - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;April 27,2018@21:08
;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
;;Per VA Directive 6402, this routine should not be modified.
;
; Last Edited: SHRPE/RM - May 02, 2018 15:50
;
; ICR# TYPE DESCRIPTION
;----- ---- -------------------------------
; 10010 Sup EN1^DIP
; 10006 Sup ^DIC
; 10086 Sup HOME^%ZIS
; 10103 Sup ^XLFDT:$$FMTE, $$NOW, $$FMADD
; 1519 Sup EN^XUTMDEVQ
; 10026 Sup ^DIR
Q
;
;Entry point for DG OTH 90-DAY PERIOD option
;B3S1
REPORT1 ;
;This subroutine will be used for selecting sort parameters
;to display all active OTH patients
;
;
;The following reporting sort array will be built by user prompts:
; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
; DGSORT("DGSRTBY") = SORT BY
; DGSORT("DGSTATUS") = OTH Patient Status to report on
;
; prompts for report selection sorts
; Input: none
; Output: Report generated using user selected parameters
;
N DGSEL ;help text var
N DGSORT ;array or report parameters
N ZTSAVE ;open array reference of input parameters used by tasking
N ZTDESC ;contains the free-text description of your task that you passed to the Program Interface.
N ZTQUEUED ;background execution
N ZTREQ ;post-execution
N ZTSTOP
N ZTRTN
N ZTSK
N VAUTD,Y ; variables for DIVISION^VAUTOMA
;
;check for database
I '+$O(^DGOTH(33,"B","")) W !,$$CJ^XLFSTR(">>> No OTH-90 records have been found. <<<",80) D ASKCONT^DGOTHMG2 Q
;
W @IOF
W !,"OTH 90-DAY PERIOD TRACKING REPORT"
W !!,"This option generates a report that prints a listing of all OTH-90 patients"
W !,"with ACTIVE or EXPIRED 90-Day period of care and who have an Outpatient"
W !,"Encounter with the STATUS=CHECKED OUT for Clinic(s) associated with the"
W !,"selected Division(s) within the user-specified date range of the 90-Day period."
W !,"Those OTH-90 patients that have been adjudicated, entered in error, or the"
W !,"Expanded MH Care Type is changed from OTH-90 to a different factor type"
W !,"will not be displayed in this report."
K DGSORT,VAUTD
;prompt for OTH-90 status user wish to print
I '$$STATUS Q
;prompt for beginning date
I '$$DATEBEG Q
;
;prompt for ending date
I '$$DATEEND Q
;
;DG*5.3*977 OTH-EXT
; select divisions to include
W !!,"Please select divisions to include in the report:"
I '$$SELDIV^DGOTHRP1 Q
I DGSORT("DIVISION")>0,'$$SORTRPT^DGOTHRP1 Q
I DGSORT("DIVISION")=0 S DGSORT("REPORT")="1^Division" ;default to sort report by divisions
;DG*5.3*977 OTH-EXT
;prompt sort by:
; 1) Patient Name
; 2) Period
; 3) Days Remaining
I 2[$P(DGSORT("REPORT"),U) S $P(DGSORT("REPORT"),U,2)="Facility"
I 13[$P(DGSORT("DGSTATUS"),U),'$$SORTBY Q
I 2[$P(DGSORT("DGSTATUS"),U) S DGSORT("DGSRTBY")="1^Patient Name"
;
;prompt for device
W !
S ZTSAVE("DGSORT(")=""
S X="OTH 90-DAY PERIOD TRACKING REPORT"
D EN^XUTMDEVQ("START^DGOTHRP2",X,.ZTSAVE)
D HOME^%ZIS
Q
;
STATUS() ;prompt OTH-90 STATUS
; 1) Active 90-Day Period
; 2) Expired 90-Day Period
; 3) Both (Active and Expired Period)
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
W !
S DGDIRA="Select 90-Day period status you wish to print"
S DGDIRB=""
S DGDIRH="^D HELP^DGOTHRPT(3)"
S DGDIRO="SO^1:Active 90-Day Period;2:Expired 90-Day Period;3:Both (Active and Expired)"
S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGSTATUS")=DGASK_U_$S(DGASK=1:"Active 90-Day Period",DGASK=2:"Expired 90-Day Period",DGASK=3:"Both (Active and Expired)",1:"")
Q DGASK>0
;
DATEBEG() ;prompt for beginning date
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT
W !
S DGDIRA="Enter Beginning Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGOTHRPT(1)"
S DGBEGDT=$$FMADD^XLFDT(DT,-90)
S DGDIRO="DO^"_DGBEGDT_":"_DT_":EX"
S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGBEG")=DGASK
Q DGASK>0
;
DATEEND() ;prompt for ending date
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGDTEND
W !
S DGDIRA="Enter Ending Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGOTHRPT(2)"
S DGDTEND=$$FMADD^XLFDT(DGSORT("DGBEG"),364)
S DGDIRO="DO^"_$$FMADD^XLFDT(DT,1)_":"_DGDTEND_":EX"
S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("DGEND")=DGASK
Q DGASK>0
;
SORTBY() ;prompt for sort by
; 1) Patient Name
; 2) Period
; 3) Days Remaining
W !
S DIR(0)="NASO^1:3"
S DIR("A")="Select OPTION: "
S DIR("A",1)="Please select how you like to sort the data within each "_$P($G(DGSORT("REPORT")),U,2)_":"
S DIR("A",2)=" Select one of the following:"
S DIR("A",3)=" "
S DIR("A",4)=" 1 Sort by Patient Name"
S DIR("A",5)=" 2 Sort by 90-Day Period"
S DIR("A",6)=" 3 Sort by Days Remaining"
S DIR("A",7)=" "
S (DIR("?"),DIR("??"))="^D HELP^DGOTHRPT(4)"
D ^DIR K DIR
S DGASK=+Y
I DGASK>0 S DGSORT("DGSRTBY")=DGASK_U_$S(DGASK=1:"Patient Name",DGASK=2:"90-Day Period",DGASK=3:"Days Remaining",1:"")
Q DGASK>0
;
ANSWER(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;
; Input
; DGDIR0 - DIR(0) string
; DGDIRA - DIR("A") string
; DGDIRB - DIR("B") string
; DGDIRH - 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(DGDIR0) S DIR(0)=DGDIR0
I $D(DGDIRA) S DIR("A")=DGDIRA
I $G(DGDIRB)]"" S DIR("B")=DGDIRB
I $D(DGDIRH) S DIR("?")=DGDIRH,DIR("??")=DGDIRH
D ^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))
;
HELP(DGSEL) ;provide extended DIR("?") help text.
;
; Input: DGSEL - prompt var for help text word selection
; Output: none
;
I X'="?",X'="??",DGSEL'=4 W !," Not a valid date.",!
N X S X=$S(DGSEL=1:"earliest",DGSEL=2:"latest",1:0)
I DGSEL=1 D
. W !," Beginning Date cannot be more than 90 days from today."
. W !," Beginning Date cannot be a future date."
I DGSEL=2 D
. W !," Ending Date is today's date + 1 day. The latest ending date was "
. W !," calculated by adding 364 days from the Beginning Date entered by the user. "
I DGSEL=3 D Q
. W !," Please Enter:",!
. W !," 1 = If you wish to print all OTH-90 MH Care patient which"
. W !," were being treated at the Division with an ACTIVE"
. W !," 90-Day period of care for a selected date range.",!
. W !," 2 = If you wish to print all OTH-90 Care patient whose"
. W !," 90-Day period has been EXPIRED or ZERO days remaining.",!
. W !," 3 = If you wish to print BOTH ACTIVE and EXPIRED 90-Day period",!
I DGSEL=4 W !," Select sort criteria within each Division." Q
W !!," Enter the "_X_" date to include in the report."
W !," Please enter a date from the specified date range displayed."
Q
;
;Entry point DG OTH STATISTICAL REPORT
;B3S2
ENSTAT ;
N DGFIRST ;first OTH patient DFN
N DGSORT ;array or report parameters
N ZTSAVE ;open array reference of input parameters used by tasking
N ZTDESC ;contains the free-text description of your task that you passed to the Program Interface.
N ZTQUEUED ;background execution
N ZTREQ ;post-execution
N ZTSTOP
N ZTRTN
N ZTSK
N DGQMON
N DGDTRNGE ;statistical report date range
;check for database
S DGFIRST=$P(+$O(^DGOTH(33,"B","")),",") ;first OTH DFN
I 'DGFIRST D Q
. W !?2,">>> No OTH-90 records were found.",*7
. I $$ANSWER^DGOTHRPT("Enter RETURN to continue","","E")
;
W @IOF
W !,"OTH 90-DAY PERIOD STATISTICAL REPORT"
W !!,"This option generates a report that prints a listing of all OTH-90 patients"
W !,"with ACTIVE or EXPIRED 90-Day periods of care, have been adjudicated, entered"
W !,"in error, or the Expanded MH Care Type is changed from OTH-90 to a different"
W !,"Expanded MH Care Type."
W !!,"The date displayed in the 'INACTIVATION DATE' column is the date the 90-Day"
W !,"countdown clock has been inactivated. The 90-Day countdown is inactivated when"
W !,"an OTH-90 patient has received adjudication, was inactivated due to data entry"
W !,"error or the Expanded MH Care Type is changed from OTH-90.",!
;prompt for fiscal year
I '$$FISCAL,'$D(DGSORT("DGFSCL")) Q
;
;prompt by Quarter or Fiscal Year (All Quarters)
I DGSORT("DGFSCL")>0,'$$QRTRALL Q
;
I 1234[$P(DGSORT("DGQTR"),U) D Q:DGQMON<1
. ;prompt month in the quarter or all quarters
. S DGQMON=$$MQ(.DGSORT)
. Q:DGQMON<1
. D DTRANGE
;
;prompt for Fiscal Year (All Quarters)
I 5[$P(DGSORT("DGQTR"),U) D FSCLYR
;prompt for device
W !
S ZTSAVE("DGSORT(")=""
S X="OTH 90-DAY PERIOD STATISTICAL REPORT"
D EN^XUTMDEVQ("START^DGOTHRP3",X,.ZTSAVE)
D HOME^%ZIS
Q
;
FISCAL() ;prompt for fiscal year
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,X
W !
S DGDIRA="Enter Fiscal Year"
S DGDIRB=""
S DGDIRH="^D HELP^DGOTHRP3"
S DGDIRO="DO^::AE"
S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I (+$E(DGASK,4,5))!(+$E(DGASK,6,7)) W ! S (X,DGASK)="" D HELP^DGOTHRP3 D FISCAL
I DGASK>0 S DGSORT("DGFSCL")=DGASK
Q DGASK>0
;
QRTRALL() ;prompt for statistical report to print
;
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFYQ
S DGDIRA="Select reporting period "
S DGDIRB=""
S DGDIRH="Enter one of the selections to report on"
S DGDIRO="SO^1:FY Quarter 1 (Oct-Nov-Dec);2:FY Quarter 2 (Jan-Feb-Mar);3:FY Quarter 3 (Apr-May-Jun);4:FY Quarter 4 (Jul-Aug-Sep);5:Fiscal Year (All Quarters)"
S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
S DGFYQ=$S(DGASK=1:"FY Quarter 1",DGASK=2:"FY Quarter 2",DGASK=3:"FY Quarter 3",DGASK=4:"FY Quarter 4",DGASK=5:"Fiscal Year (All Quarters)",1:"")
I DGASK>0 S DGSORT("DGQTR")=DGASK_U_DGFYQ
Q DGASK>0
;
MQ(DGSORT) ;prompt month in the quarter
;
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFYQ,DGMIN,DGMAX,I,DGMON,DGCNT
S DGDIRA="Select the month of the Quarter or All"
S DGDIRB=""
S DGDIRH="Enter one of the selections to report on"
S DGMIN=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^"),1,2)
S DGMAX=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^",2),1,2)
S DGCNT=0
F I=DGMIN:1:DGMAX D
. S DGCNT=DGCNT+1
. S DGMON(DGCNT)=$P($P($T(MONAME+I^DGOTHRP3),";;",2),"^",2)_U_I
S DGDIRO="SO^1:"_$P(DGMON(1),U)_";2:"_$P(DGMON(2),U)_";3:"_$P(DGMON(3),U)_";4:All Months in the Quarter"
S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 D
. S DGSORT("DGMON")=DGASK_U_$S(123[DGASK:DGMON(DGASK),1:"All Months in the Quarter")
. I 123[DGASK S DGSORT("DGMON",$P(DGMON(DGASK),U,2))=DGMON(DGASK)
. I 4[DGASK D
. . F I=1:1:3 S DGSORT("DGMON",$P(DGMON(I),U,2))=DGMON(I)
Q DGASK>0
;
DTRANGE ;calculate monthly date range
;print by monthly
N I
I 123[$P(DGSORT("DGMON"),U) D
. S DGMON=$E(DGSORT("DGFSCL"),1,3)-$S($P(DGSORT("DGQTR"),U)=1:1,1:0)
. S DGMON=DGMON_$S($P(DGSORT("DGMON"),U,3)<=9:"0"_$P(DGSORT("DGMON"),U,3),1:$P(DGSORT("DGMON"),U,3))_"00"
. S DGMON=$$MONTH(DGMON)
. S DGSORT("DGBEG")=$P(DGMON,U)
. S DGSORT("DGEND")=$P(DGMON,U,2)
E D
. ;all month in the quarter range
. S DGSORT("DGBEG")=$E(DGSORT("DGFSCL"),1,3)-$S($P(DGSORT("DGQTR"),U)=1:1,1:0)_$P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^")
. S DGSORT("DGEND")=$E(DGSORT("DGFSCL"),1,3)-$S($P(DGSORT("DGQTR"),U)=1:1,1:0)_$P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^",2)
D MSG(.DGSORT)
;
Q
;
CALRNGE(DGSORT,Q,M) ;calculate date range by month
I 4[$P(DGSORT("DGMON"),U) D
. S DGMON=$E(DGSORT("DGFSCL"),1,3)-$S($P(DGSORT("DGQTR"),U)=1:1,1:0)
. S DGMON=DGMON_$S($P(DGSORT("DGMON",M),U,2)<=9:"0"_$P(DGSORT("DGMON",M),U,2),1:$P(DGSORT("DGMON",M),U,2))_"00"
I 5[$P(DGSORT("DGMON"),U) D
. S DGMON=$E(DGSORT("DGFSCL"),1,3)-$S($G(Q)=1:1,1:0)
. S DGMON=DGMON_$S($P(DGSORT("DGMON",Q,M),U,2)<=9:"0"_$P(DGSORT("DGMON",Q,M),U,2),1:$P(DGSORT("DGMON",Q,M),U,2))_"00"
S DGMON=$$MONTH(DGMON)
Q DGMON
;
FSCLYR ;calculate fiscal year date range
N I,II,DGMIN,DGMAX
S DGSORT("DGBEG")=$E(DGSORT("DGFSCL"),1,3)-1_$P($P($T(DATES+1),";;",2),"^")
S DGSORT("DGEND")=$E(DGSORT("DGFSCL"),1,3)_$P($P($T(DATES+4),";;",2),"^",2)
;create S DGSORT("DGMON") array for the whole fiscal year
S DGSORT("DGMON")=DGSORT("DGQTR")
F I=1:1:4 D
. K DGSORT("DGQTR")
. S DGSORT("DGQTR")=I
. S DGMIN=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^"),1,2)
. S DGMAX=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^",2),1,2)
. F II=DGMIN:1:DGMAX S DGSORT("DGMON",I,II)=$P($P($T(MONAME+II^DGOTHRP3),";;",2),"^",2)_U_II
D MSG(.DGSORT)
Q
;
MSG(DGSORT) ;
S DGDTRNGE=$$FMTE^XLFDT(DGSORT("DGBEG"),5)_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),5)
W !!,"Statistical Date Range Selected: ",$$FMTE^XLFDT(DGSORT("DGBEG"),1)," to ",$$FMTE^XLFDT(DGSORT("DGEND"),1)
Q
;
DATES ;store date ranges for each quarter
;;1001^1231
;;0101^0331
;;0401^0630
;;0701^0930
Q
;
MONTH(DGRRDT) ; Pass in a date (default = today's date)
; this function returns the first and last dates of the month
N DGRRMST,DGRRMND
S:'$D(DGRRDT) DGRRDT=DT
S DGRRMST=$E(DGRRDT,1,5)_"01"
S DGRRMND=$$SCH^XLFDT("1M(1)",DGRRMST)\1
Q DGRRMST_U_DGRRMND
;
FY(DGRRDT) ; Pass in a date (default = today's date),
; and this function returns what FY we are in,
; followed by the FY start date and FY end date.
; ie. S X=$$FY^DGOTHST(3050208) results in X="FY 2005^3041000^3051000"
N DGRRST,DGRRND
S:'$D(DGRRDT) DGRRDT=DT
S DGRRST=$E(DGRRDT,1,3)-($E(DGRRDT,4,5)<10)_"1000"
S DGRRND=$E(DGRRST,1,3)+1_"1000"
Q "FY "_(1701+$E(DGRRST,1,3))_U_DGRRST_U_DGRRND
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHRPT 13710 printed Sep 23, 2025@20:22:56 Page 2
DGOTHRPT ;SLC/RM - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;April 27,2018@21:08
+1 ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Last Edited: SHRPE/RM - May 02, 2018 15:50
+5 ;
+6 ; ICR# TYPE DESCRIPTION
+7 ;----- ---- -------------------------------
+8 ; 10010 Sup EN1^DIP
+9 ; 10006 Sup ^DIC
+10 ; 10086 Sup HOME^%ZIS
+11 ; 10103 Sup ^XLFDT:$$FMTE, $$NOW, $$FMADD
+12 ; 1519 Sup EN^XUTMDEVQ
+13 ; 10026 Sup ^DIR
+14 QUIT
+15 ;
+16 ;Entry point for DG OTH 90-DAY PERIOD option
+17 ;B3S1
REPORT1 ;
+1 ;This subroutine will be used for selecting sort parameters
+2 ;to display all active OTH patients
+3 ;
+4 ;
+5 ;The following reporting sort array will be built by user prompts:
+6 ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
+7 ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
+8 ; DGSORT("DGSRTBY") = SORT BY
+9 ; DGSORT("DGSTATUS") = OTH Patient Status to report on
+10 ;
+11 ; prompts for report selection sorts
+12 ; Input: none
+13 ; Output: Report generated using user selected parameters
+14 ;
+15 ;help text var
NEW DGSEL
+16 ;array or report parameters
NEW DGSORT
+17 ;open array reference of input parameters used by tasking
NEW ZTSAVE
+18 ;contains the free-text description of your task that you passed to the Program Interface.
NEW ZTDESC
+19 ;background execution
NEW ZTQUEUED
+20 ;post-execution
NEW ZTREQ
+21 NEW ZTSTOP
+22 NEW ZTRTN
+23 NEW ZTSK
+24 ; variables for DIVISION^VAUTOMA
NEW VAUTD,Y
+25 ;
+26 ;check for database
+27 IF '+$ORDER(^DGOTH(33,"B",""))
WRITE !,$$CJ^XLFSTR(">>> No OTH-90 records have been found. <<<",80)
DO ASKCONT^DGOTHMG2
QUIT
+28 ;
+29 WRITE @IOF
+30 WRITE !,"OTH 90-DAY PERIOD TRACKING REPORT"
+31 WRITE !!,"This option generates a report that prints a listing of all OTH-90 patients"
+32 WRITE !,"with ACTIVE or EXPIRED 90-Day period of care and who have an Outpatient"
+33 WRITE !,"Encounter with the STATUS=CHECKED OUT for Clinic(s) associated with the"
+34 WRITE !,"selected Division(s) within the user-specified date range of the 90-Day period."
+35 WRITE !,"Those OTH-90 patients that have been adjudicated, entered in error, or the"
+36 WRITE !,"Expanded MH Care Type is changed from OTH-90 to a different factor type"
+37 WRITE !,"will not be displayed in this report."
+38 KILL DGSORT,VAUTD
+39 ;prompt for OTH-90 status user wish to print
+40 IF '$$STATUS
QUIT
+41 ;prompt for beginning date
+42 IF '$$DATEBEG
QUIT
+43 ;
+44 ;prompt for ending date
+45 IF '$$DATEEND
QUIT
+46 ;
+47 ;DG*5.3*977 OTH-EXT
+48 ; select divisions to include
+49 WRITE !!,"Please select divisions to include in the report:"
+50 IF '$$SELDIV^DGOTHRP1
QUIT
+51 IF DGSORT("DIVISION")>0
IF '$$SORTRPT^DGOTHRP1
QUIT
+52 ;default to sort report by divisions
IF DGSORT("DIVISION")=0
SET DGSORT("REPORT")="1^Division"
+53 ;DG*5.3*977 OTH-EXT
+54 ;prompt sort by:
+55 ; 1) Patient Name
+56 ; 2) Period
+57 ; 3) Days Remaining
+58 IF 2[$PIECE(DGSORT("REPORT"),U)
SET $PIECE(DGSORT("REPORT"),U,2)="Facility"
+59 IF 13[$PIECE(DGSORT("DGSTATUS"),U)
IF '$$SORTBY
QUIT
+60 IF 2[$PIECE(DGSORT("DGSTATUS"),U)
SET DGSORT("DGSRTBY")="1^Patient Name"
+61 ;
+62 ;prompt for device
+63 WRITE !
+64 SET ZTSAVE("DGSORT(")=""
+65 SET X="OTH 90-DAY PERIOD TRACKING REPORT"
+66 DO EN^XUTMDEVQ("START^DGOTHRP2",X,.ZTSAVE)
+67 DO HOME^%ZIS
+68 QUIT
+69 ;
STATUS() ;prompt OTH-90 STATUS
+1 ; 1) Active 90-Day Period
+2 ; 2) Expired 90-Day Period
+3 ; 3) Both (Active and Expired Period)
+4 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+5 WRITE !
+6 SET DGDIRA="Select 90-Day period status you wish to print"
+7 SET DGDIRB=""
+8 SET DGDIRH="^D HELP^DGOTHRPT(3)"
+9 SET DGDIRO="SO^1:Active 90-Day Period;2:Expired 90-Day Period;3:Both (Active and Expired)"
+10 SET DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+11 IF DGASK>0
SET DGSORT("DGSTATUS")=DGASK_U_$SELECT(DGASK=1:"Active 90-Day Period",DGASK=2:"Expired 90-Day Period",DGASK=3:"Both (Active and Expired)",1:"")
+12 QUIT DGASK>0
+13 ;
DATEBEG() ;prompt for beginning date
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT
+2 WRITE !
+3 SET DGDIRA="Enter Beginning Date"
+4 SET DGDIRB=""
+5 SET DGDIRH="^D HELP^DGOTHRPT(1)"
+6 SET DGBEGDT=$$FMADD^XLFDT(DT,-90)
+7 SET DGDIRO="DO^"_DGBEGDT_":"_DT_":EX"
+8 SET DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+9 IF DGASK>0
SET DGSORT("DGBEG")=DGASK
+10 QUIT DGASK>0
+11 ;
DATEEND() ;prompt for ending date
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGDTEND
+2 WRITE !
+3 SET DGDIRA="Enter Ending Date"
+4 SET DGDIRB=""
+5 SET DGDIRH="^D HELP^DGOTHRPT(2)"
+6 SET DGDTEND=$$FMADD^XLFDT(DGSORT("DGBEG"),364)
+7 SET DGDIRO="DO^"_$$FMADD^XLFDT(DT,1)_":"_DGDTEND_":EX"
+8 SET DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+9 IF DGASK>0
SET DGSORT("DGEND")=DGASK
+10 QUIT DGASK>0
+11 ;
SORTBY() ;prompt for sort by
+1 ; 1) Patient Name
+2 ; 2) Period
+3 ; 3) Days Remaining
+4 WRITE !
+5 SET DIR(0)="NASO^1:3"
+6 SET DIR("A")="Select OPTION: "
+7 SET DIR("A",1)="Please select how you like to sort the data within each "_$PIECE($GET(DGSORT("REPORT")),U,2)_":"
+8 SET DIR("A",2)=" Select one of the following:"
+9 SET DIR("A",3)=" "
+10 SET DIR("A",4)=" 1 Sort by Patient Name"
+11 SET DIR("A",5)=" 2 Sort by 90-Day Period"
+12 SET DIR("A",6)=" 3 Sort by Days Remaining"
+13 SET DIR("A",7)=" "
+14 SET (DIR("?"),DIR("??"))="^D HELP^DGOTHRPT(4)"
+15 DO ^DIR
KILL DIR
+16 SET DGASK=+Y
+17 IF DGASK>0
SET DGSORT("DGSRTBY")=DGASK_U_$SELECT(DGASK=1:"Patient Name",DGASK=2:"90-Day Period",DGASK=3:"Days Remaining",1:"")
+18 QUIT DGASK>0
+19 ;
ANSWER(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;
+1 ; Input
+2 ; DGDIR0 - DIR(0) string
+3 ; DGDIRA - DIR("A") string
+4 ; DGDIRB - DIR("B") string
+5 ; DGDIRH - 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(DGDIR0)
SET DIR(0)=DGDIR0
+11 IF $DATA(DGDIRA)
SET DIR("A")=DGDIRA
+12 IF $GET(DGDIRB)]""
SET DIR("B")=DGDIRB
+13 IF $DATA(DGDIRH)
SET DIR("?")=DGDIRH
SET DIR("??")=DGDIRH
+14 DO ^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 ;
HELP(DGSEL) ;provide extended DIR("?") help text.
+1 ;
+2 ; Input: DGSEL - prompt var for help text word selection
+3 ; Output: none
+4 ;
+5 IF X'="?"
IF X'="??"
IF DGSEL'=4
WRITE !," Not a valid date.",!
+6 NEW X
SET X=$SELECT(DGSEL=1:"earliest",DGSEL=2:"latest",1:0)
+7 IF DGSEL=1
Begin DoDot:1
+8 WRITE !," Beginning Date cannot be more than 90 days from today."
+9 WRITE !," Beginning Date cannot be a future date."
End DoDot:1
+10 IF DGSEL=2
Begin DoDot:1
+11 WRITE !," Ending Date is today's date + 1 day. The latest ending date was "
+12 WRITE !," calculated by adding 364 days from the Beginning Date entered by the user. "
End DoDot:1
+13 IF DGSEL=3
Begin DoDot:1
+14 WRITE !," Please Enter:",!
+15 WRITE !," 1 = If you wish to print all OTH-90 MH Care patient which"
+16 WRITE !," were being treated at the Division with an ACTIVE"
+17 WRITE !," 90-Day period of care for a selected date range.",!
+18 WRITE !," 2 = If you wish to print all OTH-90 Care patient whose"
+19 WRITE !," 90-Day period has been EXPIRED or ZERO days remaining.",!
+20 WRITE !," 3 = If you wish to print BOTH ACTIVE and EXPIRED 90-Day period",!
End DoDot:1
QUIT
+21 IF DGSEL=4
WRITE !," Select sort criteria within each Division."
QUIT
+22 WRITE !!," Enter the "_X_" date to include in the report."
+23 WRITE !," Please enter a date from the specified date range displayed."
+24 QUIT
+25 ;
+26 ;Entry point DG OTH STATISTICAL REPORT
+27 ;B3S2
ENSTAT ;
+1 ;first OTH patient DFN
NEW DGFIRST
+2 ;array or report parameters
NEW DGSORT
+3 ;open array reference of input parameters used by tasking
NEW ZTSAVE
+4 ;contains the free-text description of your task that you passed to the Program Interface.
NEW ZTDESC
+5 ;background execution
NEW ZTQUEUED
+6 ;post-execution
NEW ZTREQ
+7 NEW ZTSTOP
+8 NEW ZTRTN
+9 NEW ZTSK
+10 NEW DGQMON
+11 ;statistical report date range
NEW DGDTRNGE
+12 ;check for database
+13 ;first OTH DFN
SET DGFIRST=$PIECE(+$ORDER(^DGOTH(33,"B","")),",")
+14 IF 'DGFIRST
Begin DoDot:1
+15 WRITE !?2,">>> No OTH-90 records were found.",*7
+16 IF $$ANSWER^DGOTHRPT("Enter RETURN to continue","","E")
End DoDot:1
QUIT
+17 ;
+18 WRITE @IOF
+19 WRITE !,"OTH 90-DAY PERIOD STATISTICAL REPORT"
+20 WRITE !!,"This option generates a report that prints a listing of all OTH-90 patients"
+21 WRITE !,"with ACTIVE or EXPIRED 90-Day periods of care, have been adjudicated, entered"
+22 WRITE !,"in error, or the Expanded MH Care Type is changed from OTH-90 to a different"
+23 WRITE !,"Expanded MH Care Type."
+24 WRITE !!,"The date displayed in the 'INACTIVATION DATE' column is the date the 90-Day"
+25 WRITE !,"countdown clock has been inactivated. The 90-Day countdown is inactivated when"
+26 WRITE !,"an OTH-90 patient has received adjudication, was inactivated due to data entry"
+27 WRITE !,"error or the Expanded MH Care Type is changed from OTH-90.",!
+28 ;prompt for fiscal year
+29 IF '$$FISCAL
IF '$DATA(DGSORT("DGFSCL"))
QUIT
+30 ;
+31 ;prompt by Quarter or Fiscal Year (All Quarters)
+32 IF DGSORT("DGFSCL")>0
IF '$$QRTRALL
QUIT
+33 ;
+34 IF 1234[$PIECE(DGSORT("DGQTR"),U)
Begin DoDot:1
+35 ;prompt month in the quarter or all quarters
+36 SET DGQMON=$$MQ(.DGSORT)
+37 if DGQMON<1
QUIT
+38 DO DTRANGE
End DoDot:1
if DGQMON<1
QUIT
+39 ;
+40 ;prompt for Fiscal Year (All Quarters)
+41 IF 5[$PIECE(DGSORT("DGQTR"),U)
DO FSCLYR
+42 ;prompt for device
+43 WRITE !
+44 SET ZTSAVE("DGSORT(")=""
+45 SET X="OTH 90-DAY PERIOD STATISTICAL REPORT"
+46 DO EN^XUTMDEVQ("START^DGOTHRP3",X,.ZTSAVE)
+47 DO HOME^%ZIS
+48 QUIT
+49 ;
FISCAL() ;prompt for fiscal year
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,X
+2 WRITE !
+3 SET DGDIRA="Enter Fiscal Year"
+4 SET DGDIRB=""
+5 SET DGDIRH="^D HELP^DGOTHRP3"
+6 SET DGDIRO="DO^::AE"
+7 SET DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+8 IF (+$EXTRACT(DGASK,4,5))!(+$EXTRACT(DGASK,6,7))
WRITE !
SET (X,DGASK)=""
DO HELP^DGOTHRP3
DO FISCAL
+9 IF DGASK>0
SET DGSORT("DGFSCL")=DGASK
+10 QUIT DGASK>0
+11 ;
QRTRALL() ;prompt for statistical report to print
+1 ;
+2 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFYQ
+3 SET DGDIRA="Select reporting period "
+4 SET DGDIRB=""
+5 SET DGDIRH="Enter one of the selections to report on"
+6 SET DGDIRO="SO^1:FY Quarter 1 (Oct-Nov-Dec);2:FY Quarter 2 (Jan-Feb-Mar);3:FY Quarter 3 (Apr-May-Jun);4:FY Quarter 4 (Jul-Aug-Sep);5:Fiscal Year (All Quarters)"
+7 SET DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+8 SET DGFYQ=$SELECT(DGASK=1:"FY Quarter 1",DGASK=2:"FY Quarter 2",DGASK=3:"FY Quarter 3",DGASK=4:"FY Quarter 4",DGASK=5:"Fiscal Year (All Quarters)",1:"")
+9 IF DGASK>0
SET DGSORT("DGQTR")=DGASK_U_DGFYQ
+10 QUIT DGASK>0
+11 ;
MQ(DGSORT) ;prompt month in the quarter
+1 ;
+2 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFYQ,DGMIN,DGMAX,I,DGMON,DGCNT
+3 SET DGDIRA="Select the month of the Quarter or All"
+4 SET DGDIRB=""
+5 SET DGDIRH="Enter one of the selections to report on"
+6 SET DGMIN=$EXTRACT($PIECE($PIECE($TEXT(DATES+$PIECE(DGSORT("DGQTR"),U)),";;",2),"^"),1,2)
+7 SET DGMAX=$EXTRACT($PIECE($PIECE($TEXT(DATES+$PIECE(DGSORT("DGQTR"),U)),";;",2),"^",2),1,2)
+8 SET DGCNT=0
+9 FOR I=DGMIN:1:DGMAX
Begin DoDot:1
+10 SET DGCNT=DGCNT+1
+11 SET DGMON(DGCNT)=$PIECE($PIECE($TEXT(MONAME+I^DGOTHRP3),";;",2),"^",2)_U_I
End DoDot:1
+12 SET DGDIRO="SO^1:"_$PIECE(DGMON(1),U)_";2:"_$PIECE(DGMON(2),U)_";3:"_$PIECE(DGMON(3),U)_";4:All Months in the Quarter"
+13 SET DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+14 IF DGASK>0
Begin DoDot:1
+15 SET DGSORT("DGMON")=DGASK_U_$SELECT(123[DGASK:DGMON(DGASK),1:"All Months in the Quarter")
+16 IF 123[DGASK
SET DGSORT("DGMON",$PIECE(DGMON(DGASK),U,2))=DGMON(DGASK)
+17 IF 4[DGASK
Begin DoDot:2
+18 FOR I=1:1:3
SET DGSORT("DGMON",$PIECE(DGMON(I),U,2))=DGMON(I)
End DoDot:2
End DoDot:1
+19 QUIT DGASK>0
+20 ;
DTRANGE ;calculate monthly date range
+1 ;print by monthly
+2 NEW I
+3 IF 123[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+4 SET DGMON=$EXTRACT(DGSORT("DGFSCL"),1,3)-$SELECT($PIECE(DGSORT("DGQTR"),U)=1:1,1:0)
+5 SET DGMON=DGMON_$SELECT($PIECE(DGSORT("DGMON"),U,3)<=9:"0"_$PIECE(DGSORT("DGMON"),U,3),1:$PIECE(DGSORT("DGMON"),U,3))_"00"
+6 SET DGMON=$$MONTH(DGMON)
+7 SET DGSORT("DGBEG")=$PIECE(DGMON,U)
+8 SET DGSORT("DGEND")=$PIECE(DGMON,U,2)
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 ;all month in the quarter range
+11 SET DGSORT("DGBEG")=$EXTRACT(DGSORT("DGFSCL"),1,3)-$SELECT($PIECE(DGSORT("DGQTR"),U)=1:1,1:0)_$PIECE($PIECE($TEXT(DATES+$PIECE(DGSORT("DGQTR"),U)),";;",2),"^")
+12 SET DGSORT("DGEND")=$EXTRACT(DGSORT("DGFSCL"),1,3)-$SELECT($PIECE(DGSORT("DGQTR"),U)=1:1,1:0)_$PIECE($PIECE($TEXT(DATES+$PIECE(DGSORT("DGQTR"),U)),";;",2),"^",2)
End DoDot:1
+13 DO MSG(.DGSORT)
+14 ;
+15 QUIT
+16 ;
CALRNGE(DGSORT,Q,M) ;calculate date range by month
+1 IF 4[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+2 SET DGMON=$EXTRACT(DGSORT("DGFSCL"),1,3)-$SELECT($PIECE(DGSORT("DGQTR"),U)=1:1,1:0)
+3 SET DGMON=DGMON_$SELECT($PIECE(DGSORT("DGMON",M),U,2)<=9:"0"_$PIECE(DGSORT("DGMON",M),U,2),1:$PIECE(DGSORT("DGMON",M),U,2))_"00"
End DoDot:1
+4 IF 5[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+5 SET DGMON=$EXTRACT(DGSORT("DGFSCL"),1,3)-$SELECT($GET(Q)=1:1,1:0)
+6 SET DGMON=DGMON_$SELECT($PIECE(DGSORT("DGMON",Q,M),U,2)<=9:"0"_$PIECE(DGSORT("DGMON",Q,M),U,2),1:$PIECE(DGSORT("DGMON",Q,M),U,2))_"00"
End DoDot:1
+7 SET DGMON=$$MONTH(DGMON)
+8 QUIT DGMON
+9 ;
FSCLYR ;calculate fiscal year date range
+1 NEW I,II,DGMIN,DGMAX
+2 SET DGSORT("DGBEG")=$EXTRACT(DGSORT("DGFSCL"),1,3)-1_$PIECE($PIECE($TEXT(DATES+1),";;",2),"^")
+3 SET DGSORT("DGEND")=$EXTRACT(DGSORT("DGFSCL"),1,3)_$PIECE($PIECE($TEXT(DATES+4),";;",2),"^",2)
+4 ;create S DGSORT("DGMON") array for the whole fiscal year
+5 SET DGSORT("DGMON")=DGSORT("DGQTR")
+6 FOR I=1:1:4
Begin DoDot:1
+7 KILL DGSORT("DGQTR")
+8 SET DGSORT("DGQTR")=I
+9 SET DGMIN=$EXTRACT($PIECE($PIECE($TEXT(DATES+$PIECE(DGSORT("DGQTR"),U)),";;",2),"^"),1,2)
+10 SET DGMAX=$EXTRACT($PIECE($PIECE($TEXT(DATES+$PIECE(DGSORT("DGQTR"),U)),";;",2),"^",2),1,2)
+11 FOR II=DGMIN:1:DGMAX
SET DGSORT("DGMON",I,II)=$PIECE($PIECE($TEXT(MONAME+II^DGOTHRP3),";;",2),"^",2)_U_II
End DoDot:1
+12 DO MSG(.DGSORT)
+13 QUIT
+14 ;
MSG(DGSORT) ;
+1 SET DGDTRNGE=$$FMTE^XLFDT(DGSORT("DGBEG"),5)_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),5)
+2 WRITE !!,"Statistical Date Range Selected: ",$$FMTE^XLFDT(DGSORT("DGBEG"),1)," to ",$$FMTE^XLFDT(DGSORT("DGEND"),1)
+3 QUIT
+4 ;
DATES ;store date ranges for each quarter
+1 ;;1001^1231
+2 ;;0101^0331
+3 ;;0401^0630
+4 ;;0701^0930
+5 QUIT
+6 ;
MONTH(DGRRDT) ; Pass in a date (default = today's date)
+1 ; this function returns the first and last dates of the month
+2 NEW DGRRMST,DGRRMND
+3 if '$DATA(DGRRDT)
SET DGRRDT=DT
+4 SET DGRRMST=$EXTRACT(DGRRDT,1,5)_"01"
+5 SET DGRRMND=$$SCH^XLFDT("1M(1)",DGRRMST)\1
+6 QUIT DGRRMST_U_DGRRMND
+7 ;
FY(DGRRDT) ; Pass in a date (default = today's date),
+1 ; and this function returns what FY we are in,
+2 ; followed by the FY start date and FY end date.
+3 ; ie. S X=$$FY^DGOTHST(3050208) results in X="FY 2005^3041000^3051000"
+4 NEW DGRRST,DGRRND
+5 if '$DATA(DGRRDT)
SET DGRRDT=DT
+6 SET DGRRST=$EXTRACT(DGRRDT,1,3)-($EXTRACT(DGRRDT,4,5)<10)_"1000"
+7 SET DGRRND=$EXTRACT(DGRRST,1,3)+1_"1000"
+8 QUIT "FY "_(1701+$EXTRACT(DGRRST,1,3))_U_DGRRST_U_DGRRND
+9 ;
