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

DGOTHRPT.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;     Last Edited: SHRPE/RM - May 02, 2018 15:50
  1.  ;
  1.  ; ICR#  TYPE  DESCRIPTION
  1.  ;-----  ----  -------------------------------
  1.  ; 10010  Sup  EN1^DIP
  1.  ; 10006  Sup  ^DIC
  1.  ; 10086  Sup  HOME^%ZIS
  1.  ; 10103  Sup  ^XLFDT:$$FMTE, $$NOW, $$FMADD
  1.  ; 1519   Sup  EN^XUTMDEVQ
  1.  ; 10026  Sup  ^DIR
  1.  Q
  1.  ;
  1.  ;Entry point for DG OTH 90-DAY PERIOD option
  1.  ;B3S1
  1. REPORT1 ;
  1.  ;This subroutine will be used for selecting sort parameters
  1.  ;to display all active OTH patients
  1.  ;
  1.  ;
  1.  ;The following reporting sort array will be built by user prompts:
  1.  ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
  1.  ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
  1.  ; DGSORT("DGSRTBY") = SORT BY
  1.  ; DGSORT("DGSTATUS") = OTH Patient Status to report on
  1.  ;
  1.  ; prompts for report selection sorts
  1.  ; Input: none
  1.  ; Output: Report generated using user selected parameters
  1.  ;
  1.  N DGSEL    ;help text var
  1.  N DGSORT   ;array or report parameters
  1.  N ZTSAVE   ;open array reference of input parameters used by tasking
  1.  N ZTDESC   ;contains the free-text description of your task that you passed to the Program Interface.
  1.  N ZTQUEUED ;background execution
  1.  N ZTREQ    ;post-execution
  1.  N ZTSTOP
  1.  N ZTRTN
  1.  N ZTSK
  1.  N VAUTD,Y  ; variables for DIVISION^VAUTOMA
  1.  ;
  1.  ;check for database
  1.  I '+$O(^DGOTH(33,"B","")) W !,$$CJ^XLFSTR(">>> No OTH-90 records have been found. <<<",80) D ASKCONT^DGOTHMG2 Q
  1.  ;
  1.  W @IOF
  1.  W !,"OTH 90-DAY PERIOD TRACKING REPORT"
  1.  W !!,"This option generates a report that prints a listing of all OTH-90 patients"
  1.  W !,"with ACTIVE or EXPIRED 90-Day period of care and who have an Outpatient"
  1.  W !,"Encounter with the STATUS=CHECKED OUT for Clinic(s) associated with the"
  1.  W !,"selected Division(s) within the user-specified date range of the 90-Day period."
  1.  W !,"Those OTH-90 patients that have been adjudicated, entered in error, or the"
  1.  W !,"Expanded MH Care Type is changed from OTH-90 to a different factor type"
  1.  W !,"will not be displayed in this report."
  1.  K DGSORT,VAUTD
  1.  ;prompt for OTH-90 status user wish to print
  1.  I '$$STATUS Q
  1.  ;prompt for beginning date
  1.  I '$$DATEBEG Q
  1.  ;
  1.  ;prompt for ending date
  1.  I '$$DATEEND Q
  1.  ;
  1.  ;DG*5.3*977 OTH-EXT
  1.  ; select divisions to include
  1.  W !!,"Please select divisions to include in the report:"
  1.  I '$$SELDIV^DGOTHRP1 Q
  1.  I DGSORT("DIVISION")>0,'$$SORTRPT^DGOTHRP1 Q
  1.  I DGSORT("DIVISION")=0 S DGSORT("REPORT")="1^Division" ;default to sort report by divisions
  1.  ;DG*5.3*977 OTH-EXT
  1.  ;prompt sort by:
  1.  ; 1) Patient Name
  1.  ; 2) Period
  1.  ; 3) Days Remaining
  1.  I 2[$P(DGSORT("REPORT"),U) S $P(DGSORT("REPORT"),U,2)="Facility"
  1.  I 13[$P(DGSORT("DGSTATUS"),U),'$$SORTBY Q
  1.  I 2[$P(DGSORT("DGSTATUS"),U) S DGSORT("DGSRTBY")="1^Patient Name"
  1.  ;
  1.  ;prompt for device
  1.  W !
  1.  S ZTSAVE("DGSORT(")=""
  1.  S X="OTH 90-DAY PERIOD TRACKING REPORT"
  1.  D EN^XUTMDEVQ("START^DGOTHRP2",X,.ZTSAVE)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. STATUS() ;prompt OTH-90 STATUS
  1.  ; 1) Active 90-Day Period
  1.  ; 2) Expired 90-Day Period
  1.  ; 3) Both (Active and Expired Period)
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
  1.  W !
  1.  S DGDIRA="Select 90-Day period status you wish to print"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D HELP^DGOTHRPT(3)"
  1.  S DGDIRO="SO^1:Active 90-Day Period;2:Expired 90-Day Period;3:Both (Active and Expired)"
  1.  S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  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:"")
  1.  Q DGASK>0
  1.  ;
  1. DATEBEG() ;prompt for beginning date
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT
  1.  W !
  1.  S DGDIRA="Enter Beginning Date"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D HELP^DGOTHRPT(1)"
  1.  S DGBEGDT=$$FMADD^XLFDT(DT,-90)
  1.  S DGDIRO="DO^"_DGBEGDT_":"_DT_":EX"
  1.  S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 S DGSORT("DGBEG")=DGASK
  1.  Q DGASK>0
  1.  ;
  1. DATEEND() ;prompt for ending date
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGDTEND
  1.  W !
  1.  S DGDIRA="Enter Ending Date"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D HELP^DGOTHRPT(2)"
  1.  S DGDTEND=$$FMADD^XLFDT(DGSORT("DGBEG"),364)
  1.  S DGDIRO="DO^"_$$FMADD^XLFDT(DT,1)_":"_DGDTEND_":EX"
  1.  S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 S DGSORT("DGEND")=DGASK
  1.  Q DGASK>0
  1.  ;
  1. SORTBY() ;prompt for sort by
  1.  ; 1) Patient Name
  1.  ; 2) Period
  1.  ; 3) Days Remaining
  1.  W !
  1.  S DIR(0)="NASO^1:3"
  1.  S DIR("A")="Select OPTION: "
  1.  S DIR("A",1)="Please select how you like to sort the data within each "_$P($G(DGSORT("REPORT")),U,2)_":"
  1.  S DIR("A",2)="     Select one of the following:"
  1.  S DIR("A",3)=" "
  1.  S DIR("A",4)="          1         Sort by Patient Name"
  1.  S DIR("A",5)="          2         Sort by 90-Day Period"
  1.  S DIR("A",6)="          3         Sort by Days Remaining"
  1.  S DIR("A",7)=" "
  1.  S (DIR("?"),DIR("??"))="^D HELP^DGOTHRPT(4)"
  1.  D ^DIR K DIR
  1.  S DGASK=+Y
  1.  I DGASK>0 S DGSORT("DGSRTBY")=DGASK_U_$S(DGASK=1:"Patient Name",DGASK=2:"90-Day Period",DGASK=3:"Days Remaining",1:"")
  1.  Q DGASK>0
  1.  ;
  1. ANSWER(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;
  1.  ; Input
  1.  ; DGDIR0 - DIR(0) string
  1.  ; DGDIRA - DIR("A") string
  1.  ; DGDIRB - DIR("B") string
  1.  ; DGDIRH - DIR("?") string
  1.  ; Output
  1.  ; Function Value - Internal value returned from ^DIR or -1 if user
  1.  ; up-arrows, double up-arrows or the read times out.
  1.  N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  I $D(DGDIR0) S DIR(0)=DGDIR0
  1.  I $D(DGDIRA) S DIR("A")=DGDIRA
  1.  I $G(DGDIRB)]"" S DIR("B")=DGDIRB
  1.  I $D(DGDIRH) S DIR("?")=DGDIRH,DIR("??")=DGDIRH
  1.  D ^DIR
  1.  S Z=$S($D(DTOUT):-2,$D(DUOUT):-1,$D(DIROUT):-1,1:"")
  1.  I Z="" S Z=$S(Y=-1:"",X="@":"@",1:$P(Y,U)) Q Z
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1.  Q $S(X="@":"@",1:$P(Y,U))
  1.  ;
  1. HELP(DGSEL) ;provide extended DIR("?") help text.
  1.  ;
  1.  ; Input: DGSEL - prompt var for help text word selection
  1.  ; Output: none
  1.  ;
  1.  I X'="?",X'="??",DGSEL'=4 W !,"  Not a valid date.",!
  1.  N X S X=$S(DGSEL=1:"earliest",DGSEL=2:"latest",1:0)
  1.  I DGSEL=1 D
  1.  . W !,"  Beginning Date cannot be more than 90 days from today."
  1.  . W !,"  Beginning Date cannot be a future date."
  1.  I DGSEL=2 D
  1.  . W !,"  Ending Date is today's date + 1 day. The latest ending date was "
  1.  . W !,"  calculated by adding 364 days from the Beginning Date entered by the user. "
  1.  I DGSEL=3 D  Q
  1.  . W !,"  Please Enter:",!
  1.  . W !,"    1 = If you wish to print all OTH-90 MH Care patient which"
  1.  . W !,"        were being treated at the Division with an ACTIVE"
  1.  . W !,"        90-Day period of care for a selected date range.",!
  1.  . W !,"    2 = If you wish to print all OTH-90 Care patient whose"
  1.  . W !,"        90-Day period has been EXPIRED or ZERO days remaining.",!
  1.  . W !,"    3 = If you wish to print BOTH ACTIVE and EXPIRED 90-Day period",!
  1.  I DGSEL=4 W !,"  Select sort criteria within each Division." Q
  1.  W !!,"  Enter the "_X_" date to include in the report."
  1.  W !,"  Please enter a date from the specified date range displayed."
  1.  Q
  1.  ;
  1.  ;Entry point DG OTH STATISTICAL REPORT
  1.  ;B3S2
  1. ENSTAT ;
  1.  N DGFIRST  ;first OTH patient DFN
  1.  N DGSORT   ;array or report parameters
  1.  N ZTSAVE   ;open array reference of input parameters used by tasking
  1.  N ZTDESC   ;contains the free-text description of your task that you passed to the Program Interface.
  1.  N ZTQUEUED ;background execution
  1.  N ZTREQ    ;post-execution
  1.  N ZTSTOP
  1.  N ZTRTN
  1.  N ZTSK
  1.  N DGQMON
  1.  N DGDTRNGE ;statistical report date range
  1.  ;check for database
  1.  S DGFIRST=$P(+$O(^DGOTH(33,"B","")),",") ;first OTH DFN
  1.  I 'DGFIRST D  Q
  1.  . W !?2,">>> No OTH-90 records were found.",*7
  1.  . I $$ANSWER^DGOTHRPT("Enter RETURN to continue","","E")
  1.  ;
  1.  W @IOF
  1.  W !,"OTH 90-DAY PERIOD STATISTICAL REPORT"
  1.  W !!,"This option generates a report that prints a listing of all OTH-90 patients"
  1.  W !,"with ACTIVE or EXPIRED 90-Day periods of care, have been adjudicated, entered"
  1.  W !,"in error, or the Expanded MH Care Type is changed from OTH-90 to a different"
  1.  W !,"Expanded MH Care Type."
  1.  W !!,"The date displayed in the 'INACTIVATION DATE' column is the date the 90-Day"
  1.  W !,"countdown clock has been inactivated. The 90-Day countdown is inactivated when"
  1.  W !,"an OTH-90 patient has received adjudication, was inactivated due to data entry"
  1.  W !,"error or the Expanded MH Care Type is changed from OTH-90.",!
  1.  ;prompt for fiscal year
  1.  I '$$FISCAL,'$D(DGSORT("DGFSCL")) Q
  1.  ;
  1.  ;prompt by Quarter or Fiscal Year (All Quarters)
  1.  I DGSORT("DGFSCL")>0,'$$QRTRALL Q
  1.  ;
  1.  I 1234[$P(DGSORT("DGQTR"),U) D  Q:DGQMON<1
  1.  . ;prompt month in the quarter or all quarters
  1.  . S DGQMON=$$MQ(.DGSORT)
  1.  . Q:DGQMON<1
  1.  . D DTRANGE
  1.  ;
  1.  ;prompt for Fiscal Year (All Quarters)
  1.  I 5[$P(DGSORT("DGQTR"),U) D FSCLYR
  1.  ;prompt for device
  1.  W !
  1.  S ZTSAVE("DGSORT(")=""
  1.  S X="OTH 90-DAY PERIOD STATISTICAL REPORT"
  1.  D EN^XUTMDEVQ("START^DGOTHRP3",X,.ZTSAVE)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. FISCAL() ;prompt for fiscal year
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,X
  1.  W !
  1.  S DGDIRA="Enter Fiscal Year"
  1.  S DGDIRB=""
  1.  S DGDIRH="^D HELP^DGOTHRP3"
  1.  S DGDIRO="DO^::AE"
  1.  S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I (+$E(DGASK,4,5))!(+$E(DGASK,6,7)) W ! S (X,DGASK)="" D HELP^DGOTHRP3 D FISCAL
  1.  I DGASK>0 S DGSORT("DGFSCL")=DGASK
  1.  Q DGASK>0
  1.  ;
  1. QRTRALL() ;prompt for statistical report to print
  1.  ;
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFYQ
  1.  S DGDIRA="Select reporting period "
  1.  S DGDIRB=""
  1.  S DGDIRH="Enter one of the selections to report on"
  1.  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)"
  1.  S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  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:"")
  1.  I DGASK>0 S DGSORT("DGQTR")=DGASK_U_DGFYQ
  1.  Q DGASK>0
  1.  ;
  1. MQ(DGSORT) ;prompt month in the quarter
  1.  ;
  1.  N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFYQ,DGMIN,DGMAX,I,DGMON,DGCNT
  1.  S DGDIRA="Select the month of the Quarter or All"
  1.  S DGDIRB=""
  1.  S DGDIRH="Enter one of the selections to report on"
  1.  S DGMIN=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^"),1,2)
  1.  S DGMAX=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^",2),1,2)
  1.  S DGCNT=0
  1.  F I=DGMIN:1:DGMAX D
  1.  . S DGCNT=DGCNT+1
  1.  . S DGMON(DGCNT)=$P($P($T(MONAME+I^DGOTHRP3),";;",2),"^",2)_U_I
  1.  S DGDIRO="SO^1:"_$P(DGMON(1),U)_";2:"_$P(DGMON(2),U)_";3:"_$P(DGMON(3),U)_";4:All Months in the Quarter"
  1.  S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1.  I DGASK>0 D
  1.  . S DGSORT("DGMON")=DGASK_U_$S(123[DGASK:DGMON(DGASK),1:"All Months in the Quarter")
  1.  . I 123[DGASK S DGSORT("DGMON",$P(DGMON(DGASK),U,2))=DGMON(DGASK)
  1.  . I 4[DGASK D
  1.  . . F I=1:1:3 S DGSORT("DGMON",$P(DGMON(I),U,2))=DGMON(I)
  1.  Q DGASK>0
  1.  ;
  1. DTRANGE ;calculate monthly date range
  1.  ;print by monthly
  1.  N I
  1.  I 123[$P(DGSORT("DGMON"),U) D
  1.  . S DGMON=$E(DGSORT("DGFSCL"),1,3)-$S($P(DGSORT("DGQTR"),U)=1:1,1:0)
  1.  . S DGMON=DGMON_$S($P(DGSORT("DGMON"),U,3)<=9:"0"_$P(DGSORT("DGMON"),U,3),1:$P(DGSORT("DGMON"),U,3))_"00"
  1.  . S DGMON=$$MONTH(DGMON)
  1.  . S DGSORT("DGBEG")=$P(DGMON,U)
  1.  . S DGSORT("DGEND")=$P(DGMON,U,2)
  1.  E  D
  1.  . ;all month in the quarter range
  1.  . 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),"^")
  1.  . 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)
  1.  D MSG(.DGSORT)
  1.  ;
  1.  Q
  1.  ;
  1. CALRNGE(DGSORT,Q,M) ;calculate date range by month
  1.  I 4[$P(DGSORT("DGMON"),U) D
  1.  . S DGMON=$E(DGSORT("DGFSCL"),1,3)-$S($P(DGSORT("DGQTR"),U)=1:1,1:0)
  1.  . 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"
  1.  I 5[$P(DGSORT("DGMON"),U) D
  1.  . S DGMON=$E(DGSORT("DGFSCL"),1,3)-$S($G(Q)=1:1,1:0)
  1.  . 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"
  1.  S DGMON=$$MONTH(DGMON)
  1.  Q DGMON
  1.  ;
  1. FSCLYR ;calculate fiscal year date range
  1.  N I,II,DGMIN,DGMAX
  1.  S DGSORT("DGBEG")=$E(DGSORT("DGFSCL"),1,3)-1_$P($P($T(DATES+1),";;",2),"^")
  1.  S DGSORT("DGEND")=$E(DGSORT("DGFSCL"),1,3)_$P($P($T(DATES+4),";;",2),"^",2)
  1.  ;create S DGSORT("DGMON") array for the whole fiscal year
  1.  S DGSORT("DGMON")=DGSORT("DGQTR")
  1.  F I=1:1:4 D
  1.  . K DGSORT("DGQTR")
  1.  . S DGSORT("DGQTR")=I
  1.  . S DGMIN=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^"),1,2)
  1.  . S DGMAX=$E($P($P($T(DATES+$P(DGSORT("DGQTR"),U)),";;",2),"^",2),1,2)
  1.  . F II=DGMIN:1:DGMAX S DGSORT("DGMON",I,II)=$P($P($T(MONAME+II^DGOTHRP3),";;",2),"^",2)_U_II
  1.  D MSG(.DGSORT)
  1.  Q
  1.  ;
  1. MSG(DGSORT) ;
  1.  S DGDTRNGE=$$FMTE^XLFDT(DGSORT("DGBEG"),5)_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),5)
  1.  W !!,"Statistical Date Range Selected: ",$$FMTE^XLFDT(DGSORT("DGBEG"),1)," to ",$$FMTE^XLFDT(DGSORT("DGEND"),1)
  1.  Q
  1.  ;
  1. DATES ;store date ranges for each quarter
  1.  ;;1001^1231
  1.  ;;0101^0331
  1.  ;;0401^0630
  1.  ;;0701^0930
  1.  Q
  1.  ;
  1. MONTH(DGRRDT) ; Pass in a date (default = today's date)
  1.  ; this function returns the first and last dates of the month
  1.  N DGRRMST,DGRRMND
  1.  S:'$D(DGRRDT) DGRRDT=DT
  1.  S DGRRMST=$E(DGRRDT,1,5)_"01"
  1.  S DGRRMND=$$SCH^XLFDT("1M(1)",DGRRMST)\1
  1.  Q DGRRMST_U_DGRRMND
  1.  ;
  1. FY(DGRRDT) ; Pass in a date (default = today's date),
  1.  ; and this function returns what FY we are in,
  1.  ; followed by the FY start date and FY end date.
  1.  ; ie. S X=$$FY^DGOTHST(3050208) results in X="FY 2005^3041000^3051000"
  1.  N DGRRST,DGRRND
  1.  S:'$D(DGRRDT) DGRRDT=DT
  1.  S DGRRST=$E(DGRRDT,1,3)-($E(DGRRDT,4,5)<10)_"1000"
  1.  S DGRRND=$E(DGRRST,1,3)+1_"1000"
  1.  Q "FY "_(1701+$E(DGRRST,1,3))_U_DGRRST_U_DGRRND
  1.  ;