DGOTHRP1 ;SLC/RED,RM - OTHD (OTHER THAN HONORABLE DISCHARGE) Reports ;May 9,2018@05:08
;;5.3;Registration;**952,977**;May 9, 2018;Build 177
;;Per VA Directive 6402, this routine should not be modified.
;
; Last Edited: SHRPE/RED,RM - August 21, 2019 09:00
;
; ICR# TYPE DESCRIPTION
;----- ---- -------------------------------
; 10103 Sup ^XLFDT - [$$FMTE^XLFDT, $$NOW^XLFDT]
; 10015 Sup ^DIQ
; 10086 Sup HOME^%ZIS
; 10063 Sup ^%ZTLOAD
; 1519 Sup EN^XUTMDEVQ
; 10089 Sup ^%ZISC
; 10026 Sup ^DIR
; 10112 Sup $$SITE^VASITE
; 10024 Sup WAIT^DICD
; 664 Cont. Sub DIVISION^VAUTOMA
; 417 Cont. Sub DG has approval for direct global read of File #40.8
; 3546 Cont. Sub DG has approval for direct global read of "AD" index of FILE #40.8
; 402 Cont. Sub DG has approval for direct global read of "ADFN" index of FILE #409.68
;
Q ; No Direct access
; Menu text: Other Than Honorable MH Status Report
EN ; CALLED BY - DG OTH MH STATUS REPORT - menu option
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 DGOUT,DGSORT,VAUTD
;
W @IOF
W !,"OTHER THAN HONORABLE MH STATUS REPORT",!
W !,"This option generates a report that displays a list(s) of Patients who had"
W !,"EXPANDED MH CARE NON-ENROLLEE primary eligibility assigned, changed from"
W !,"being EXPANDED MH CARE NON-ENROLLEE who have an Outpatient Encounter with"
W !,"with STATUS=CHECKED OUT for Clinic(s) associated with the selected Division(s)"
W !,"within the user-specified date range.",!
;check for database
;DG*5.3*977 OTH-EXT
I '+$O(^DGOTH(33,"B","")) W !,$$CJ^XLFSTR(">>> No OTH-90 Records have been found. <<<",80) D ASKCONT^DGOTHMG2 Q
;
K DGSORT,VAUTD
;prompt for OTH MH status report type that user wish to print
I '$$STATUS Q
;prompt for beginning date
W !
I '$$DATEBEG Q
;prompt for ending date
I '$$DATEEND Q
W !
;DG*5.3*977 OTH-EXT
;prompt user to select DIVISION
W !,"Please select divisions to include in the report"
I '$$SELDIV Q
;DGSORT("DIVISION")=0 -- user only select one division
;DGSORT("DIVISION")=1 -- user select ALL division
;DGSORT("DIVISION")>1 -- user select multiple division but not all
;if user selected division is many or all but not one
;prompt user on how the report will be sorted
I DGSORT("DIVISION")>0,'$$SORTRPT Q
I DGSORT("DIVISION")=0 S DGSORT("REPORT")="1^Patient Name" ;default to sort report by divisions
;
S DGOUT=$NA(^TMP($J,"DGOTHRP1")) K @DGOUT ;Set and kill tmp global for report
;prompt for device
W !
S ZTSAVE("DGSORT(")=""
S X="OTHER THAN HONORABLE MH STATUS REPORT"
D EN^XUTMDEVQ("STAT^DGOTHRP1",X,.ZTSAVE)
D HOME^%ZIS
Q
;
STATUS() ;prompt for OTH MH status report type that user wish to print
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
S DGDIRA="Select OTH MH status you wish to print"
S DGDIRB=3
S DGDIRH="^D HELP^DGOTHRP1(1)"
S DGDIRO="SO^1:Activated "_$$STAT2()_";2:Inactivated "_$$STAT2()_";3:Both"
S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
I DGASK>0 S DGSORT("OTHSTAT")=DGASK_U_$S(DGASK=1:"Activated "_$$STAT2(),DGASK=2:"Inactivated "_$$STAT2(),1:"Both (Activated/Inactivated)")
Q DGASK>0
;
STAT2() ;
Q "OTH MH Status"
;
DATEBEG() ;prompt for beginning date
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT,DONE
S DGDIRA="Start with Date"
S DGDIRB=""
S DGDIRH="^D HELP^DGOTHRP1(2)"
S DGDIRO="DO^:DT:EX"
S DONE=0
F D Q:DONE
. ;keep prompting until user enter a valid entry
. S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
. I DGASK="" W !!," A date is required. Enter '^' to exit.",! S DONE=0 Q
. I DGASK>0 S DGSORT("DGBEG")=DGASK,DONE=1
. I DGASK<0 S DONE=1
Q DGASK>0
;
DATEEND() ;prompt for ending date
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DONE
S DGDIRA=" End with Date: "
S DGDIRB=$$FMTE^XLFDT(DT)
S DGDIRH="^D HELP^DGOTHRP1(3)"
S DGDIRO="DOA^"_DGSORT("DGBEG")_"::EX"
S DONE=0
F D Q:DONE
. ;keep prompting until user enter a valid entry
. S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
. I DGASK>0,DGASK<DGSORT("DGBEG") W !!," Ending date must be after beginning date",! S DONE=0 Q
. I DGASK>0 S DGSORT("DGEND")=DGASK,DONE=1
. I DGASK<0 S DONE=1
Q DGASK>0
;
;DG*5.3*977 OTH-EXT
SELDIV() ;prompt for DIVISION
N DIV,FAC,Y,DIVCNT,INS
I '$D(^DG(40.8,+$O(^DG(40.8,0)),0)) D Q 0
. W !!,*7,"***WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!
;get division
D DIVISION^VAUTOMA
Q:Y<0 Y>0
S DGSORT("DIVISION")=VAUTD
S DIVCNT=0
I VAUTD=0 D
. S DIV=0 F S DIV=$O(VAUTD(DIV)) Q:DIV'>0 D
. . S FAC=$$STA^XUAF4($$GET1^DIQ(40.8,DIV_",",.07,"I"))
. . I $G(FAC)="" S FAC=$$GETDIV(DIV)
. . S DGSORT("DIVISION",DIV,FAC)=$G(VAUTD(DIV))
. . S DIVCNT=DIVCNT+1
. ;if user selects only one division
. ;leave the DGSORT("DIVISION")=0 as is
. I DIVCNT>1 S DGSORT("DIVISION")=DIVCNT
E D
. S INS="" F S INS=$O(^DG(40.8,"AD",INS)) Q:INS="" D
. . S DIV="" F S DIV=$O(^DG(40.8,"AD",INS,DIV)) Q:DIV="" D
. . . S FAC=$$STA^XUAF4($$GET1^DIQ(40.8,DIV_",",.07,"I"))
. . . I $G(FAC)="" S FAC=$$GETDIV(DIV)
. . . S DGSORT("DIVISION",DIV,FAC)=$$GET1^DIQ(40.8,DIV_",",.01,"E")
Q 1
;
;DG*5.3*977 OTH-EXT
GETDIV(X) ;get division for one or many but not all
;Input X=ien medical center division
;Output Y=division number 3-6 characters
N Y S Y=""
Q:X="" Y
S Y=$P($G(^DG(40.8,X,0)),"^",2) ;Get station/facility number
Q Y
;
;DG*5.3*977 OTH-EXT
SORTRPT() ;prompt user how the report will be sorted
N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DONE
S DGDIRA="Sort Report By"
S DGDIRB=""
S DGDIRH="^D HELP^DGOTHRP1(4)"
S DGDIRO="SO^1:Division;2:Facility"
S DONE=0
F D Q:DONE
. ;keep prompting until user enter a valid entry
. S DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
. I DGASK="" W !!," Report Sort is required. Enter '^' to exit." S DONE=0 Q
. I DGASK>0 S DGSORT("REPORT")=DGASK_U_$S(DGASK=1:"Division",1:"Patient Name"),DONE=1
. I DGASK<0 S DONE=1
Q DGASK>0
;
STAT ; Entry point if Queued
N DGDFN,DGCNT,TMPARY,DGARR,DGOTHIST,DGERR,DGPID,DGRET
N CNT,DGELIG,DGPEDT,DGOTHSTAT,DGIEN33,OTH90,DGPTNAME
I $E(IOST)="C" D WAIT^DICD
N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name
N TRM S TRM=($E(IOST)="C")
S DGDFN=""
F S DGDFN=$O(^DGOTH(33,"B",DGDFN)) Q:DGDFN="" D
. K DGARR,DGOTHIST,DGERR,DGPID,OTH90,DGPTNAME
. S DGIEN33=$$HASENTRY^DGOTHD2(DGDFN)
. S DGCNT=0
. D GETS^DIQ(33,DGIEN33_",",".01;.02;2*","IE","DGARR","DGERR")
. Q:$D(DGERR)
. S OTH90=$$CROSS^DGOTHINQ(DGIEN33,.DGOTHIST)
. Q:$P(OTH90,U,4)="" ;No history on file
. S DGPTNAME=DGARR(33,DGIEN33_",",.01,"E")
. S CNT="" F S CNT=$O(DGOTHIST(DGIEN33,CNT)) Q:CNT="" D
. . K DGELIG,DGPEDT
. . S DGELIG=$P(DGOTHIST(DGIEN33,CNT),U)
. . S DGPEDT=$P(DGOTHIST(DGIEN33,CNT),U,2)
. . I '$$CHKDATE(DGPEDT,.DGSORT) Q
. . I 1[$P(DGSORT("OTHSTAT"),U),DGARR(33,DGIEN33_",",.02,"I")>0 D BUILD
. . I 2[$P(DGSORT("OTHSTAT"),U),DGARR(33,DGIEN33_",",.02,"I")<1 D BUILD
. . I 3[$P(DGSORT("OTHSTAT"),U) D BUILD
;print/display the report
D DSPLY1
D EXIT
Q
;
BUILD ;
;check if there any Outpatient Encounter entry for this patient
;DG*5.3*977 OTH-EXT
K DGRET
D CHKTREAT^DGPPRP1(.DGRET,+DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),.VAUTD)
Q:'$D(DGRET)
S DGPID=$$SSN^DGOTHRP2(DGDFN)
S DGOTHSTAT=$S(DGELIG="OTH-90"!(DGELIG="OTH-EXT"):"Active",1:"Inactive")
S DGCNT=DGCNT+1
N DGDIV,DGSDT,TMPDIV
S (DGDIV,DGSDT,TMPDIV)=""
F S DGDIV=$O(DGRET(DGDIV)) Q:DGDIV="" D
. F S DGSDT=$O(DGRET(DGDIV,DGSDT)) Q:DGSDT="" D
. . S TMPDIV=$P(DGRET(DGDIV,DGSDT),U,2)
. . I TMPDIV="" S TMPDIV=$S($P(^DG(40.8,DGDIV,0),U,2)="":"UNKNOWN",1:$P(^DG(40.8,DGDIV,0),U,2))
. . I TMPDIV["UNKNOWN" S DGSORT("DIVISION",DGDIV,TMPDIV)=DGRET(DGDIV,DGSDT)
. . I 1[$P(DGSORT("REPORT"),U) D BYDIV
. . E D BYFAC
Q
;
;DG*5.3*977 OTH-EXT
BYDIV ;Build data for report display by DIVISION
;
I '$D(@DGOUT@(TMPDIV,DGPTNAME,DGSDT)) S @DGOUT@(TMPDIV,DGPTNAME,DGSDT)=DGRET(DGDIV,DGSDT)
S @DGOUT@(TMPDIV,DGPTNAME,DGSDT,DGCNT)=DGDFN_U_DGPID_U_DGPEDT_U_DGOTHSTAT_U_DGELIG
Q
;
;DG*5.3*977 OTH-EXT
BYFAC ;Build data for report display by FACILITY
I '$D(@DGOUT@(DGPTNAME,TMPDIV,DGSDT)) S @DGOUT@(DGPTNAME,TMPDIV,DGSDT)=DGRET(DGDIV,DGSDT)
S @DGOUT@(DGPTNAME,TMPDIV,DGSDT,DGCNT)=DGDFN_U_DGPID_U_DGPEDT_U_DGOTHSTAT_U_DGELIG
Q
;
CHKDATE(DGPEDT,DGSORT) ;
;Input:
;DGMHPEDT - OTH MH Status Primary Eligibility change date
;DGSORT - Report parameters
;
;Output:
;Return 1 if Primary Eligibility change date falls within the user-specified date range
;Otherwise, 0
;check if this patient had at least one active/inactive status in its OTH life cycle
;within the user-specified date range
Q DGSORT("DGBEG")<=DGPEDT&(DGPEDT<=DGSORT("DGEND"))
;
DSPLY1 ;Print/Display Report
N DGPAGE,DDASH,DGQ,SUB1,SUB2,SUB3,SUB4,DGSTR,DGCNT
N DGOLD,DGOLD1,DGOLD2,DGFAC,DGDIV
S (DGQ,DGPAGE)=0,$P(DDASH,"-",81)=""
I $O(@DGOUT@(""))="" D Q
.D PRTHDR
.W !!," >>> No records were found using the report criteria.",!
.D ASKCONT^DGOTHMG2
.Q
; loop and print/display report
S (DGSTR,DGCNT,DGOLD,DGOLD1,DGOLD2)=""
S (SUB1,SUB2,SUB3,SUB4)=""
I 1[$P(DGSORT("REPORT"),U) D
.D PRTHDR
.S DGDIV="" F S DGDIV=$O(DGSORT("DIVISION",DGDIV)) Q:DGDIV="" D Q:DGQ
..S DGFAC="" F S DGFAC=$O(DGSORT("DIVISION",DGDIV,DGFAC)) Q:DGFAC="" D Q:DGQ
...I '$D(@DGOUT@(DGFAC)) D Q
....D PAUSE^DGOTHRP2(.DGQ) Q:DGQ D PRTHDR W !
....W "Division: ",DGSORT("DIVISION",DGDIV,DGFAC)_" ("_DGFAC_")",!
....W !," >>> No records were found for this division.",!!
....S DGOLD=DGFAC
....Q
...I DGOLD1'=SUB1 D PAUSE^DGOTHRP2(.DGQ) Q:DGQ D PRTHDR W !
...D DSPLY2(DGFAC)
...Q
..Q
.Q:DGQ
.W !,"<END OF REPORT>"
.Q
I 2[$P(DGSORT("REPORT"),U) D
. D PRTHDR
. S SUB1="" F S SUB1=$O(@DGOUT@(SUB1)) Q:SUB1="" D Q:DGQ
. . D DSPLY2(SUB1)
. Q:DGQ
. W !,"<END OF REPORT>"
Q:DGQ
D ASKCONT^DGOTHMG2
Q
;
DSPLY2(SUB1) ;
S SUB2="" F S SUB2=$O(@DGOUT@(SUB1,SUB2)) Q:SUB2="" D Q:DGQ
. S SUB3="" F S SUB3=$O(@DGOUT@(SUB1,SUB2,SUB3)) Q:SUB3="" D Q:DGQ
. . S SUB4="" F S SUB4=$O(@DGOUT@(SUB1,SUB2,SUB3,SUB4)) Q:SUB4="" D Q:DGQ
. . . K DGSTR
. . . S DGSTR=$G(@DGOUT@(SUB1,SUB2,SUB3,SUB4))
. . . I $Y>(IOSL-4) D PAUSE^DGOTHRP2(.DGQ) Q:DGQ D
. . . . D PRTHDR W !
. . . . D DIVHDR($S(1[$P(DGSORT("REPORT"),U):1,1:2))
. . . . I 1[$P(DGSORT("REPORT"),U) D DIVHDR1(1) Q
. . . I 1[$P(DGSORT("REPORT"),U) D PRNTDIV
. . . I 2[$P(DGSORT("REPORT"),U) D PRNTFAC
. . Q:DGQ
. Q:DGQ
Q
;
;DG*5.3*977 OTH-EXT
PRNTDIV ;Print/Display Report by Division
I DGOLD1'=SUB1 D
. D DIVHDR(1),DIVHDR1(1)
I DGOLD1=SUB1,DGOLD'=$P(DGSTR,U) D DIVHDR1(1)
;do not display again the history of the patient if:
; 1. Division remains the same
; 2. The same patient
I DGOLD1=SUB1,DGOLD2'=SUB3 Q
W ?29,$$FMTE^XLFDT($P(DGSTR,U,3),"5Z"),?41,$P(DGSTR,U,4),?51,$E($P(DGSTR,U,5),1,28),!
Q
;
;DG*5.3*977 OTH-EXT
DIVHDR(NXTPGE) ;Display Division header
I NXTPGE=1 W "Division: ",$P(@DGOUT@(SUB1,SUB2,SUB3),U)," (",SUB1,")",!
I NXTPGE>1 D
. W $E(SUB1,1,20),?22,$P(DGSTR,U,2)
. S DGOLD=$P(DGSTR,U),DGOLD1=SUB1,DGOLD2=SUB3
Q
;
;DG*5.3*977 OTH-EXT
DIVHDR1(RPTSRT) ;
W !,$S(RPTSRT=1:$E(SUB2,1,20),1:$E(SUB1,1,20)),?22,$P(DGSTR,U,2)
S DGOLD=$P(DGSTR,U),DGOLD1=SUB1,DGOLD2=SUB3
Q
;
;DG*5.3*977 OTH-EXT
PRNTFAC ;Print/Display Report by Facility
I $P(DGSTR,U)'=DGOLD D DIVHDR1(2)
;do not display again the history of the patient if:
; 1. Division remains the same
; 2. The same patient
I $P(DGSTR,U)=DGOLD,DGOLD2'=SUB3 Q
W ?29,$$FMTE^XLFDT($P(DGSTR,U,3),"5Z"),?41,$P(DGSTR,U,4),?51,$E($P(DGSTR,U,5),1,28),!
Q
;
PRTHDR ;Print/Display Page Header
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
N DGFACLTY
I TRM!('TRM&DGPAGE) W @IOF
S DGPAGE=$G(DGPAGE)+1
S DGFACLTY="Facility: "_$P(HERE,U,2)
W !,?80-$L(ZTDESC)\2,$G(ZTDESC),?71,"Page:",?77,DGPAGE
W !,?80-$L(DGFACLTY)\2,DGFACLTY
W !,"Status :",?12,$P($G(DGSORT("OTHSTAT")),U,2),?46,"Sorted By: ",?58,$P($G(DGSORT("REPORT")),U,2)
W !,"Date Range:",?12,$$FMTE^XLFDT(DGSORT("DGBEG"),"5Z")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5Z")
W ?46,"Printed :",?58,$$FMTE^XLFDT($$NOW^XLFDT,"MP")
W !,DDASH
W !,"PATIENT NAME",?22,"PID",?29,"OTH MH PE",?41,"OTH MH",?51,"Eligibility"
W !,?29,"Change DT",?41,"Status",?59
W !,DDASH
Q
;
EXIT ;
K @DGOUT
Q
;
;DG*5.3*977 OTH-EXT
HELP(DGSEL) ;
;
; Input: DGSEL - prompt var for help text word selection
; Output: none
;
I X'="?",X'="??" W !," Not a valid date."
I DGSEL=1 D
. W !," Please Enter:",!
. W !," 1 Activated OTH MH Status"
. W !," If you wish to display a list(s) of patients whose Primary Eligibility"
. W !," was SET TO EXPANDED MH CARE NON-ENROLLEE during selected timeframe,"
. W !," treated in selected division(s))"
. W !," "
. W !," 2 Inactivated OTH MH Status"
. W !," If you wish to display a list(s) of patients whose Primary Eligibility"
. W !," was CHANGED FROM being EXPANDED MH CARE NON-ENROLLEE during selected"
. W !," timeframe, treated in selected division(s))."
. W !," "
. W !," 3 Both"
. W !," If you wish to display a list(s) of patients whose Primary Eligibility"
. W !," was either set to EXPANDED MH CARE NON-ENROLLEE or changed from being"
. W !," EXPANDED MH CARE NON-ENROLLEE during selected timeframe, treated in"
. W !," selected division(s)."
I DGSEL=2 D
. W !," Start Date is today's date, T-(number of days) or a specific date "
. W !," from the past.",!," Start date cannot be a future date."
I DGSEL=3 W !," End date must be greater than or equal to the start date."
I DGSEL=4 D
. W !," Please Enter:",!
. W !," 1 Divisions"
. W !," Report output is sorted by Division, sorted first numerically,"
. W !," then alphabetically, then by Patient Name."
. W !," "
. W !," 2 Facility"
. W !," Report output will display list(s) of patients treated in the Facility"
. W !," or any Divisions, during selected range, then sorted by Patient Name."
Q
;
;END OF DGOTHRP1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHRP1 14495 printed Dec 13, 2024@02:46:58 Page 2
DGOTHRP1 ;SLC/RED,RM - OTHD (OTHER THAN HONORABLE DISCHARGE) Reports ;May 9,2018@05:08
+1 ;;5.3;Registration;**952,977**;May 9, 2018;Build 177
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Last Edited: SHRPE/RED,RM - August 21, 2019 09:00
+5 ;
+6 ; ICR# TYPE DESCRIPTION
+7 ;----- ---- -------------------------------
+8 ; 10103 Sup ^XLFDT - [$$FMTE^XLFDT, $$NOW^XLFDT]
+9 ; 10015 Sup ^DIQ
+10 ; 10086 Sup HOME^%ZIS
+11 ; 10063 Sup ^%ZTLOAD
+12 ; 1519 Sup EN^XUTMDEVQ
+13 ; 10089 Sup ^%ZISC
+14 ; 10026 Sup ^DIR
+15 ; 10112 Sup $$SITE^VASITE
+16 ; 10024 Sup WAIT^DICD
+17 ; 664 Cont. Sub DIVISION^VAUTOMA
+18 ; 417 Cont. Sub DG has approval for direct global read of File #40.8
+19 ; 3546 Cont. Sub DG has approval for direct global read of "AD" index of FILE #40.8
+20 ; 402 Cont. Sub DG has approval for direct global read of "ADFN" index of FILE #409.68
+21 ;
+22 ; No Direct access
QUIT
+23 ; Menu text: Other Than Honorable MH Status Report
EN ; CALLED BY - DG OTH MH STATUS REPORT - menu option
+1 ;open array reference of input parameters used by tasking
NEW ZTSAVE
+2 ;contains the free-text description of your task that you passed to the Program Interface.
NEW ZTDESC
+3 ;background execution
NEW ZTQUEUED
+4 ;post-execution
NEW ZTREQ
+5 NEW ZTSTOP
+6 NEW ZTRTN
+7 NEW ZTSK
+8 NEW DGOUT,DGSORT,VAUTD
+9 ;
+10 WRITE @IOF
+11 WRITE !,"OTHER THAN HONORABLE MH STATUS REPORT",!
+12 WRITE !,"This option generates a report that displays a list(s) of Patients who had"
+13 WRITE !,"EXPANDED MH CARE NON-ENROLLEE primary eligibility assigned, changed from"
+14 WRITE !,"being EXPANDED MH CARE NON-ENROLLEE who have an Outpatient Encounter with"
+15 WRITE !,"with STATUS=CHECKED OUT for Clinic(s) associated with the selected Division(s)"
+16 WRITE !,"within the user-specified date range.",!
+17 ;check for database
+18 ;DG*5.3*977 OTH-EXT
+19 IF '+$ORDER(^DGOTH(33,"B",""))
WRITE !,$$CJ^XLFSTR(">>> No OTH-90 Records have been found. <<<",80)
DO ASKCONT^DGOTHMG2
QUIT
+20 ;
+21 KILL DGSORT,VAUTD
+22 ;prompt for OTH MH status report type that user wish to print
+23 IF '$$STATUS
QUIT
+24 ;prompt for beginning date
+25 WRITE !
+26 IF '$$DATEBEG
QUIT
+27 ;prompt for ending date
+28 IF '$$DATEEND
QUIT
+29 WRITE !
+30 ;DG*5.3*977 OTH-EXT
+31 ;prompt user to select DIVISION
+32 WRITE !,"Please select divisions to include in the report"
+33 IF '$$SELDIV
QUIT
+34 ;DGSORT("DIVISION")=0 -- user only select one division
+35 ;DGSORT("DIVISION")=1 -- user select ALL division
+36 ;DGSORT("DIVISION")>1 -- user select multiple division but not all
+37 ;if user selected division is many or all but not one
+38 ;prompt user on how the report will be sorted
+39 IF DGSORT("DIVISION")>0
IF '$$SORTRPT
QUIT
+40 ;default to sort report by divisions
IF DGSORT("DIVISION")=0
SET DGSORT("REPORT")="1^Patient Name"
+41 ;
+42 ;Set and kill tmp global for report
SET DGOUT=$NAME(^TMP($JOB,"DGOTHRP1"))
KILL @DGOUT
+43 ;prompt for device
+44 WRITE !
+45 SET ZTSAVE("DGSORT(")=""
+46 SET X="OTHER THAN HONORABLE MH STATUS REPORT"
+47 DO EN^XUTMDEVQ("STAT^DGOTHRP1",X,.ZTSAVE)
+48 DO HOME^%ZIS
+49 QUIT
+50 ;
STATUS() ;prompt for OTH MH status report type that user wish to print
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
+2 SET DGDIRA="Select OTH MH status you wish to print"
+3 SET DGDIRB=3
+4 SET DGDIRH="^D HELP^DGOTHRP1(1)"
+5 SET DGDIRO="SO^1:Activated "_$$STAT2()_";2:Inactivated "_$$STAT2()_";3:Both"
+6 SET DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+7 IF DGASK>0
SET DGSORT("OTHSTAT")=DGASK_U_$SELECT(DGASK=1:"Activated "_$$STAT2(),DGASK=2:"Inactivated "_$$STAT2(),1:"Both (Activated/Inactivated)")
+8 QUIT DGASK>0
+9 ;
STAT2() ;
+1 QUIT "OTH MH Status"
+2 ;
DATEBEG() ;prompt for beginning date
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT,DONE
+2 SET DGDIRA="Start with Date"
+3 SET DGDIRB=""
+4 SET DGDIRH="^D HELP^DGOTHRP1(2)"
+5 SET DGDIRO="DO^:DT:EX"
+6 SET DONE=0
+7 FOR
Begin DoDot:1
+8 ;keep prompting until user enter a valid entry
+9 SET DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+10 IF DGASK=""
WRITE !!," A date is required. Enter '^' to exit.",!
SET DONE=0
QUIT
+11 IF DGASK>0
SET DGSORT("DGBEG")=DGASK
SET DONE=1
+12 IF DGASK<0
SET DONE=1
End DoDot:1
if DONE
QUIT
+13 QUIT DGASK>0
+14 ;
DATEEND() ;prompt for ending date
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DONE
+2 SET DGDIRA=" End with Date: "
+3 SET DGDIRB=$$FMTE^XLFDT(DT)
+4 SET DGDIRH="^D HELP^DGOTHRP1(3)"
+5 SET DGDIRO="DOA^"_DGSORT("DGBEG")_"::EX"
+6 SET DONE=0
+7 FOR
Begin DoDot:1
+8 ;keep prompting until user enter a valid entry
+9 SET DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+10 IF DGASK>0
IF DGASK<DGSORT("DGBEG")
WRITE !!," Ending date must be after beginning date",!
SET DONE=0
QUIT
+11 IF DGASK>0
SET DGSORT("DGEND")=DGASK
SET DONE=1
+12 IF DGASK<0
SET DONE=1
End DoDot:1
if DONE
QUIT
+13 QUIT DGASK>0
+14 ;
+15 ;DG*5.3*977 OTH-EXT
SELDIV() ;prompt for DIVISION
+1 NEW DIV,FAC,Y,DIVCNT,INS
+2 IF '$DATA(^DG(40.8,+$ORDER(^DG(40.8,0)),0))
Begin DoDot:1
+3 WRITE !!,*7,"***WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP",!
End DoDot:1
QUIT 0
+4 ;get division
+5 DO DIVISION^VAUTOMA
+6 if Y<0
QUIT Y>0
+7 SET DGSORT("DIVISION")=VAUTD
+8 SET DIVCNT=0
+9 IF VAUTD=0
Begin DoDot:1
+10 SET DIV=0
FOR
SET DIV=$ORDER(VAUTD(DIV))
if DIV'>0
QUIT
Begin DoDot:2
+11 SET FAC=$$STA^XUAF4($$GET1^DIQ(40.8,DIV_",",.07,"I"))
+12 IF $GET(FAC)=""
SET FAC=$$GETDIV(DIV)
+13 SET DGSORT("DIVISION",DIV,FAC)=$GET(VAUTD(DIV))
+14 SET DIVCNT=DIVCNT+1
End DoDot:2
+15 ;if user selects only one division
+16 ;leave the DGSORT("DIVISION")=0 as is
+17 IF DIVCNT>1
SET DGSORT("DIVISION")=DIVCNT
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 SET INS=""
FOR
SET INS=$ORDER(^DG(40.8,"AD",INS))
if INS=""
QUIT
Begin DoDot:2
+20 SET DIV=""
FOR
SET DIV=$ORDER(^DG(40.8,"AD",INS,DIV))
if DIV=""
QUIT
Begin DoDot:3
+21 SET FAC=$$STA^XUAF4($$GET1^DIQ(40.8,DIV_",",.07,"I"))
+22 IF $GET(FAC)=""
SET FAC=$$GETDIV(DIV)
+23 SET DGSORT("DIVISION",DIV,FAC)=$$GET1^DIQ(40.8,DIV_",",.01,"E")
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT 1
+25 ;
+26 ;DG*5.3*977 OTH-EXT
GETDIV(X) ;get division for one or many but not all
+1 ;Input X=ien medical center division
+2 ;Output Y=division number 3-6 characters
+3 NEW Y
SET Y=""
+4 if X=""
QUIT Y
+5 ;Get station/facility number
SET Y=$PIECE($GET(^DG(40.8,X,0)),"^",2)
+6 QUIT Y
+7 ;
+8 ;DG*5.3*977 OTH-EXT
SORTRPT() ;prompt user how the report will be sorted
+1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DONE
+2 SET DGDIRA="Sort Report By"
+3 SET DGDIRB=""
+4 SET DGDIRH="^D HELP^DGOTHRP1(4)"
+5 SET DGDIRO="SO^1:Division;2:Facility"
+6 SET DONE=0
+7 FOR
Begin DoDot:1
+8 ;keep prompting until user enter a valid entry
+9 SET DGASK=$$ANSWER^DGOTHRPT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+10 IF DGASK=""
WRITE !!," Report Sort is required. Enter '^' to exit."
SET DONE=0
QUIT
+11 IF DGASK>0
SET DGSORT("REPORT")=DGASK_U_$SELECT(DGASK=1:"Division",1:"Patient Name")
SET DONE=1
+12 IF DGASK<0
SET DONE=1
End DoDot:1
if DONE
QUIT
+13 QUIT DGASK>0
+14 ;
STAT ; Entry point if Queued
+1 NEW DGDFN,DGCNT,TMPARY,DGARR,DGOTHIST,DGERR,DGPID,DGRET
+2 NEW CNT,DGELIG,DGPEDT,DGOTHSTAT,DGIEN33,OTH90,DGPTNAME
+3 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+4 ;extract the IEN and facility name
NEW HERE
SET HERE=$$SITE^VASITE
+5 NEW TRM
SET TRM=($EXTRACT(IOST)="C")
+6 SET DGDFN=""
+7 FOR
SET DGDFN=$ORDER(^DGOTH(33,"B",DGDFN))
if DGDFN=""
QUIT
Begin DoDot:1
+8 KILL DGARR,DGOTHIST,DGERR,DGPID,OTH90,DGPTNAME
+9 SET DGIEN33=$$HASENTRY^DGOTHD2(DGDFN)
+10 SET DGCNT=0
+11 DO GETS^DIQ(33,DGIEN33_",",".01;.02;2*","IE","DGARR","DGERR")
+12 if $DATA(DGERR)
QUIT
+13 SET OTH90=$$CROSS^DGOTHINQ(DGIEN33,.DGOTHIST)
+14 ;No history on file
if $PIECE(OTH90,U,4)=""
QUIT
+15 SET DGPTNAME=DGARR(33,DGIEN33_",",.01,"E")
+16 SET CNT=""
FOR
SET CNT=$ORDER(DGOTHIST(DGIEN33,CNT))
if CNT=""
QUIT
Begin DoDot:2
+17 KILL DGELIG,DGPEDT
+18 SET DGELIG=$PIECE(DGOTHIST(DGIEN33,CNT),U)
+19 SET DGPEDT=$PIECE(DGOTHIST(DGIEN33,CNT),U,2)
+20 IF '$$CHKDATE(DGPEDT,.DGSORT)
QUIT
+21 IF 1[$PIECE(DGSORT("OTHSTAT"),U)
IF DGARR(33,DGIEN33_",",.02,"I")>0
DO BUILD
+22 IF 2[$PIECE(DGSORT("OTHSTAT"),U)
IF DGARR(33,DGIEN33_",",.02,"I")<1
DO BUILD
+23 IF 3[$PIECE(DGSORT("OTHSTAT"),U)
DO BUILD
End DoDot:2
End DoDot:1
+24 ;print/display the report
+25 DO DSPLY1
+26 DO EXIT
+27 QUIT
+28 ;
BUILD ;
+1 ;check if there any Outpatient Encounter entry for this patient
+2 ;DG*5.3*977 OTH-EXT
+3 KILL DGRET
+4 DO CHKTREAT^DGPPRP1(.DGRET,+DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),.VAUTD)
+5 if '$DATA(DGRET)
QUIT
+6 SET DGPID=$$SSN^DGOTHRP2(DGDFN)
+7 SET DGOTHSTAT=$SELECT(DGELIG="OTH-90"!(DGELIG="OTH-EXT"):"Active",1:"Inactive")
+8 SET DGCNT=DGCNT+1
+9 NEW DGDIV,DGSDT,TMPDIV
+10 SET (DGDIV,DGSDT,TMPDIV)=""
+11 FOR
SET DGDIV=$ORDER(DGRET(DGDIV))
if DGDIV=""
QUIT
Begin DoDot:1
+12 FOR
SET DGSDT=$ORDER(DGRET(DGDIV,DGSDT))
if DGSDT=""
QUIT
Begin DoDot:2
+13 SET TMPDIV=$PIECE(DGRET(DGDIV,DGSDT),U,2)
+14 IF TMPDIV=""
SET TMPDIV=$SELECT($PIECE(^DG(40.8,DGDIV,0),U,2)="":"UNKNOWN",1:$PIECE(^DG(40.8,DGDIV,0),U,2))
+15 IF TMPDIV["UNKNOWN"
SET DGSORT("DIVISION",DGDIV,TMPDIV)=DGRET(DGDIV,DGSDT)
+16 IF 1[$PIECE(DGSORT("REPORT"),U)
DO BYDIV
+17 IF '$TEST
DO BYFAC
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
+20 ;DG*5.3*977 OTH-EXT
BYDIV ;Build data for report display by DIVISION
+1 ;
+2 IF '$DATA(@DGOUT@(TMPDIV,DGPTNAME,DGSDT))
SET @DGOUT@(TMPDIV,DGPTNAME,DGSDT)=DGRET(DGDIV,DGSDT)
+3 SET @DGOUT@(TMPDIV,DGPTNAME,DGSDT,DGCNT)=DGDFN_U_DGPID_U_DGPEDT_U_DGOTHSTAT_U_DGELIG
+4 QUIT
+5 ;
+6 ;DG*5.3*977 OTH-EXT
BYFAC ;Build data for report display by FACILITY
+1 IF '$DATA(@DGOUT@(DGPTNAME,TMPDIV,DGSDT))
SET @DGOUT@(DGPTNAME,TMPDIV,DGSDT)=DGRET(DGDIV,DGSDT)
+2 SET @DGOUT@(DGPTNAME,TMPDIV,DGSDT,DGCNT)=DGDFN_U_DGPID_U_DGPEDT_U_DGOTHSTAT_U_DGELIG
+3 QUIT
+4 ;
CHKDATE(DGPEDT,DGSORT) ;
+1 ;Input:
+2 ;DGMHPEDT - OTH MH Status Primary Eligibility change date
+3 ;DGSORT - Report parameters
+4 ;
+5 ;Output:
+6 ;Return 1 if Primary Eligibility change date falls within the user-specified date range
+7 ;Otherwise, 0
+8 ;check if this patient had at least one active/inactive status in its OTH life cycle
+9 ;within the user-specified date range
+10 QUIT DGSORT("DGBEG")<=DGPEDT&(DGPEDT<=DGSORT("DGEND"))
+11 ;
DSPLY1 ;Print/Display Report
+1 NEW DGPAGE,DDASH,DGQ,SUB1,SUB2,SUB3,SUB4,DGSTR,DGCNT
+2 NEW DGOLD,DGOLD1,DGOLD2,DGFAC,DGDIV
+3 SET (DGQ,DGPAGE)=0
SET $PIECE(DDASH,"-",81)=""
+4 IF $ORDER(@DGOUT@(""))=""
Begin DoDot:1
+5 DO PRTHDR
+6 WRITE !!," >>> No records were found using the report criteria.",!
+7 DO ASKCONT^DGOTHMG2
+8 QUIT
End DoDot:1
QUIT
+9 ; loop and print/display report
+10 SET (DGSTR,DGCNT,DGOLD,DGOLD1,DGOLD2)=""
+11 SET (SUB1,SUB2,SUB3,SUB4)=""
+12 IF 1[$PIECE(DGSORT("REPORT"),U)
Begin DoDot:1
+13 DO PRTHDR
+14 SET DGDIV=""
FOR
SET DGDIV=$ORDER(DGSORT("DIVISION",DGDIV))
if DGDIV=""
QUIT
Begin DoDot:2
+15 SET DGFAC=""
FOR
SET DGFAC=$ORDER(DGSORT("DIVISION",DGDIV,DGFAC))
if DGFAC=""
QUIT
Begin DoDot:3
+16 IF '$DATA(@DGOUT@(DGFAC))
Begin DoDot:4
+17 DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
DO PRTHDR
WRITE !
+18 WRITE "Division: ",DGSORT("DIVISION",DGDIV,DGFAC)_" ("_DGFAC_")",!
+19 WRITE !," >>> No records were found for this division.",!!
+20 SET DGOLD=DGFAC
+21 QUIT
End DoDot:4
QUIT
+22 IF DGOLD1'=SUB1
DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
DO PRTHDR
WRITE !
+23 DO DSPLY2(DGFAC)
+24 QUIT
End DoDot:3
if DGQ
QUIT
+25 QUIT
End DoDot:2
if DGQ
QUIT
+26 if DGQ
QUIT
+27 WRITE !,"<END OF REPORT>"
+28 QUIT
End DoDot:1
+29 IF 2[$PIECE(DGSORT("REPORT"),U)
Begin DoDot:1
+30 DO PRTHDR
+31 SET SUB1=""
FOR
SET SUB1=$ORDER(@DGOUT@(SUB1))
if SUB1=""
QUIT
Begin DoDot:2
+32 DO DSPLY2(SUB1)
End DoDot:2
if DGQ
QUIT
+33 if DGQ
QUIT
+34 WRITE !,"<END OF REPORT>"
End DoDot:1
+35 if DGQ
QUIT
+36 DO ASKCONT^DGOTHMG2
+37 QUIT
+38 ;
DSPLY2(SUB1) ;
+1 SET SUB2=""
FOR
SET SUB2=$ORDER(@DGOUT@(SUB1,SUB2))
if SUB2=""
QUIT
Begin DoDot:1
+2 SET SUB3=""
FOR
SET SUB3=$ORDER(@DGOUT@(SUB1,SUB2,SUB3))
if SUB3=""
QUIT
Begin DoDot:2
+3 SET SUB4=""
FOR
SET SUB4=$ORDER(@DGOUT@(SUB1,SUB2,SUB3,SUB4))
if SUB4=""
QUIT
Begin DoDot:3
+4 KILL DGSTR
+5 SET DGSTR=$GET(@DGOUT@(SUB1,SUB2,SUB3,SUB4))
+6 IF $Y>(IOSL-4)
DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
Begin DoDot:4
+7 DO PRTHDR
WRITE !
+8 DO DIVHDR($SELECT(1[$PIECE(DGSORT("REPORT"),U):1,1:2))
+9 IF 1[$PIECE(DGSORT("REPORT"),U)
DO DIVHDR1(1)
QUIT
End DoDot:4
+10 IF 1[$PIECE(DGSORT("REPORT"),U)
DO PRNTDIV
+11 IF 2[$PIECE(DGSORT("REPORT"),U)
DO PRNTFAC
End DoDot:3
if DGQ
QUIT
+12 if DGQ
QUIT
End DoDot:2
if DGQ
QUIT
+13 if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+14 QUIT
+15 ;
+16 ;DG*5.3*977 OTH-EXT
PRNTDIV ;Print/Display Report by Division
+1 IF DGOLD1'=SUB1
Begin DoDot:1
+2 DO DIVHDR(1)
DO DIVHDR1(1)
End DoDot:1
+3 IF DGOLD1=SUB1
IF DGOLD'=$PIECE(DGSTR,U)
DO DIVHDR1(1)
+4 ;do not display again the history of the patient if:
+5 ; 1. Division remains the same
+6 ; 2. The same patient
+7 IF DGOLD1=SUB1
IF DGOLD2'=SUB3
QUIT
+8 WRITE ?29,$$FMTE^XLFDT($PIECE(DGSTR,U,3),"5Z"),?41,$PIECE(DGSTR,U,4),?51,$EXTRACT($PIECE(DGSTR,U,5),1,28),!
+9 QUIT
+10 ;
+11 ;DG*5.3*977 OTH-EXT
DIVHDR(NXTPGE) ;Display Division header
+1 IF NXTPGE=1
WRITE "Division: ",$PIECE(@DGOUT@(SUB1,SUB2,SUB3),U)," (",SUB1,")",!
+2 IF NXTPGE>1
Begin DoDot:1
+3 WRITE $EXTRACT(SUB1,1,20),?22,$PIECE(DGSTR,U,2)
+4 SET DGOLD=$PIECE(DGSTR,U)
SET DGOLD1=SUB1
SET DGOLD2=SUB3
End DoDot:1
+5 QUIT
+6 ;
+7 ;DG*5.3*977 OTH-EXT
DIVHDR1(RPTSRT) ;
+1 WRITE !,$SELECT(RPTSRT=1:$EXTRACT(SUB2,1,20),1:$EXTRACT(SUB1,1,20)),?22,$PIECE(DGSTR,U,2)
+2 SET DGOLD=$PIECE(DGSTR,U)
SET DGOLD1=SUB1
SET DGOLD2=SUB3
+3 QUIT
+4 ;
+5 ;DG*5.3*977 OTH-EXT
PRNTFAC ;Print/Display Report by Facility
+1 IF $PIECE(DGSTR,U)'=DGOLD
DO DIVHDR1(2)
+2 ;do not display again the history of the patient if:
+3 ; 1. Division remains the same
+4 ; 2. The same patient
+5 IF $PIECE(DGSTR,U)=DGOLD
IF DGOLD2'=SUB3
QUIT
+6 WRITE ?29,$$FMTE^XLFDT($PIECE(DGSTR,U,3),"5Z"),?41,$PIECE(DGSTR,U,4),?51,$EXTRACT($PIECE(DGSTR,U,5),1,28),!
+7 QUIT
+8 ;
PRTHDR ;Print/Display Page Header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,DGQ)=1
QUIT
+2 NEW DGFACLTY
+3 IF TRM!('TRM&DGPAGE)
WRITE @IOF
+4 SET DGPAGE=$GET(DGPAGE)+1
+5 SET DGFACLTY="Facility: "_$PIECE(HERE,U,2)
+6 WRITE !,?80-$LENGTH(ZTDESC)\2,$GET(ZTDESC),?71,"Page:",?77,DGPAGE
+7 WRITE !,?80-$LENGTH(DGFACLTY)\2,DGFACLTY
+8 WRITE !,"Status :",?12,$PIECE($GET(DGSORT("OTHSTAT")),U,2),?46,"Sorted By: ",?58,$PIECE($GET(DGSORT("REPORT")),U,2)
+9 WRITE !,"Date Range:",?12,$$FMTE^XLFDT(DGSORT("DGBEG"),"5Z")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5Z")
+10 WRITE ?46,"Printed :",?58,$$FMTE^XLFDT($$NOW^XLFDT,"MP")
+11 WRITE !,DDASH
+12 WRITE !,"PATIENT NAME",?22,"PID",?29,"OTH MH PE",?41,"OTH MH",?51,"Eligibility"
+13 WRITE !,?29,"Change DT",?41,"Status",?59
+14 WRITE !,DDASH
+15 QUIT
+16 ;
EXIT ;
+1 KILL @DGOUT
+2 QUIT
+3 ;
+4 ;DG*5.3*977 OTH-EXT
HELP(DGSEL) ;
+1 ;
+2 ; Input: DGSEL - prompt var for help text word selection
+3 ; Output: none
+4 ;
+5 IF X'="?"
IF X'="??"
WRITE !," Not a valid date."
+6 IF DGSEL=1
Begin DoDot:1
+7 WRITE !," Please Enter:",!
+8 WRITE !," 1 Activated OTH MH Status"
+9 WRITE !," If you wish to display a list(s) of patients whose Primary Eligibility"
+10 WRITE !," was SET TO EXPANDED MH CARE NON-ENROLLEE during selected timeframe,"
+11 WRITE !," treated in selected division(s))"
+12 WRITE !," "
+13 WRITE !," 2 Inactivated OTH MH Status"
+14 WRITE !," If you wish to display a list(s) of patients whose Primary Eligibility"
+15 WRITE !," was CHANGED FROM being EXPANDED MH CARE NON-ENROLLEE during selected"
+16 WRITE !," timeframe, treated in selected division(s))."
+17 WRITE !," "
+18 WRITE !," 3 Both"
+19 WRITE !," If you wish to display a list(s) of patients whose Primary Eligibility"
+20 WRITE !," was either set to EXPANDED MH CARE NON-ENROLLEE or changed from being"
+21 WRITE !," EXPANDED MH CARE NON-ENROLLEE during selected timeframe, treated in"
+22 WRITE !," selected division(s)."
End DoDot:1
+23 IF DGSEL=2
Begin DoDot:1
+24 WRITE !," Start Date is today's date, T-(number of days) or a specific date "
+25 WRITE !," from the past.",!," Start date cannot be a future date."
End DoDot:1
+26 IF DGSEL=3
WRITE !," End date must be greater than or equal to the start date."
+27 IF DGSEL=4
Begin DoDot:1
+28 WRITE !," Please Enter:",!
+29 WRITE !," 1 Divisions"
+30 WRITE !," Report output is sorted by Division, sorted first numerically,"
+31 WRITE !," then alphabetically, then by Patient Name."
+32 WRITE !," "
+33 WRITE !," 2 Facility"
+34 WRITE !," Report output will display list(s) of patients treated in the Facility"
+35 WRITE !," or any Divisions, during selected range, then sorted by Patient Name."
End DoDot:1
+36 QUIT
+37 ;
+38 ;END OF DGOTHRP1
