DGENRPB1 ;ALB/CJM - Pending Applications for Enrollment Report; May 4,1998
;;5.3;Registration;**147**;08/13/93
;
REPORT ;
N DGENEND,DGENBEG,DGENINST
;
S DGENBEG=$$ASKBEGIN()
G:'DGENBEG EXIT
S DGENEND=$$ASKEND(.DGENBEG)
G:'DGENEND EXIT
G:'$$ASKINST(.DGENINST) EXIT
I $$DEVICE() D PRINT^DGENRPB2
EXIT ;
Q
;
DEVICE() ;
;Description: allows the user to select a device.
;Input: none
;
;Output:
; Function Value - Returns 0 if the user decides not to print or to
; queue the report, 1 otherwise.
;
N OK
S OK=1
S %ZIS="MQ"
W !,"*** This report requires a 132 column printer. ******"
D ^%ZIS
S:POP OK=0
D:OK&$D(IO("Q"))
.S ZTRTN="PRINT^DGENRPB2",ZTDESC="Pending Applications for Enrollment REPORT",ZTSAVE("DGEN*")=""
.D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS
.S OK=0
Q OK
;
ASKBEGIN() ;
;Description: Asks the user to enter a beginning date.
;
;Input: none
;Output: Returns the date as the function value, or 0 if the user does nto select a date
;
N DIR,X,Y
S DIR(0)="D^::X"
S DIR("A")="Enter Beginning Date"
;S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-730),"D")
S DIR("?",1)="Please enter a date. Veterans who applied for enrollment earlier will not"
S DIR("?")="be included in the report."
D ^DIR
Q:$D(DIRUT) 0
Q Y
;
ASKEND(DGBEGIN) ;
;Description: Asks the user to enter an end date.
;
;Input:
; DGBEGIN - the earliest possible date
;
;Output: Returns the date as the function value, or 0 if the user does nto select a date
;
N DIR,X,Y
S DIR(0)="D^::X"
S DIR("A")="Enter Ending Date"
S DIR("B")=$$FMTE^XLFDT(DT,"D")
S DIR("?",1)="Please enter a date. Veterans who applied for enrollment later will not"
S DIR("?")="be included in the report."
AGAIN D ^DIR
Q:$D(DIRUT) 0
I (Y<$G(DGBEGIN)) W !,"Date must be no earlier than "_$$FMTE^XLFDT(DGBEGIN,"D") G AGAIN
Q Y
;
ASKINST(INST) ;
;Description: As the user to specify the divisions to report
;Input: none
;
;Output:
; Function Value - 0 on success, 1 on failure
; INST - array of institutions selected (pass by reference)
; subscripts:
; ("ALL")=1 if all selected, 0 otherwise
; (<ien of facility in instititution file>)=""
;
N SUCCESS,DONE
S SUCCESS=1,DONE=0
K INST
;
;ask if all facilities should be included
D
.N DIR
.S DIR(0)="YA"
.S DIR("A")="Do you want the report for ALL facilities? "
.S DIR("B")="YES"
.S DIR("?")="The report will inlcude only selected instititutions, as determined by the patient's chosen preferred facility, if you select YES"
.D ^DIR
.I $D(DIRUT) S SUCCESS=0 Q
.S INST("ALL")=Y
;
;if the user wants to select particular facilities, ask for list
I SUCCESS,'INST("ALL") F Q:DONE Q:'SUCCESS D
.N DIR
.S DIR(0)="P^4:AEM"
.D ^DIR
.I +Y>0 S INST(+Y)=""
.S DIR(0)="YA"
.S DIR("A")="Do you want to select another facility? "
.S DIR("B")="YES"
.D ^DIR
.I $D(DIRUT) S SUCCESS=0
.I Y=0 S DONE=1
Q SUCCESS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENRPB1 3085 printed Dec 13, 2024@02:43 Page 2
DGENRPB1 ;ALB/CJM - Pending Applications for Enrollment Report; May 4,1998
+1 ;;5.3;Registration;**147**;08/13/93
+2 ;
REPORT ;
+1 NEW DGENEND,DGENBEG,DGENINST
+2 ;
+3 SET DGENBEG=$$ASKBEGIN()
+4 if 'DGENBEG
GOTO EXIT
+5 SET DGENEND=$$ASKEND(.DGENBEG)
+6 if 'DGENEND
GOTO EXIT
+7 if '$$ASKINST(.DGENINST)
GOTO EXIT
+8 IF $$DEVICE()
DO PRINT^DGENRPB2
EXIT ;
+1 QUIT
+2 ;
DEVICE() ;
+1 ;Description: allows the user to select a device.
+2 ;Input: none
+3 ;
+4 ;Output:
+5 ; Function Value - Returns 0 if the user decides not to print or to
+6 ; queue the report, 1 otherwise.
+7 ;
+8 NEW OK
+9 SET OK=1
+10 SET %ZIS="MQ"
+11 WRITE !,"*** This report requires a 132 column printer. ******"
+12 DO ^%ZIS
+13 if POP
SET OK=0
+14 if OK&$DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTRTN="PRINT^DGENRPB2"
SET ZTDESC="Pending Applications for Enrollment REPORT"
SET ZTSAVE("DGEN*")=""
+16 DO ^%ZTLOAD
+17 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+18 DO HOME^%ZIS
+19 SET OK=0
End DoDot:1
+20 QUIT OK
+21 ;
ASKBEGIN() ;
+1 ;Description: Asks the user to enter a beginning date.
+2 ;
+3 ;Input: none
+4 ;Output: Returns the date as the function value, or 0 if the user does nto select a date
+5 ;
+6 NEW DIR,X,Y
+7 SET DIR(0)="D^::X"
+8 SET DIR("A")="Enter Beginning Date"
+9 ;S DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-730),"D")
+10 SET DIR("?",1)="Please enter a date. Veterans who applied for enrollment earlier will not"
+11 SET DIR("?")="be included in the report."
+12 DO ^DIR
+13 if $DATA(DIRUT)
QUIT 0
+14 QUIT Y
+15 ;
ASKEND(DGBEGIN) ;
+1 ;Description: Asks the user to enter an end date.
+2 ;
+3 ;Input:
+4 ; DGBEGIN - the earliest possible date
+5 ;
+6 ;Output: Returns the date as the function value, or 0 if the user does nto select a date
+7 ;
+8 NEW DIR,X,Y
+9 SET DIR(0)="D^::X"
+10 SET DIR("A")="Enter Ending Date"
+11 SET DIR("B")=$$FMTE^XLFDT(DT,"D")
+12 SET DIR("?",1)="Please enter a date. Veterans who applied for enrollment later will not"
+13 SET DIR("?")="be included in the report."
AGAIN DO ^DIR
+1 if $DATA(DIRUT)
QUIT 0
+2 IF (Y<$GET(DGBEGIN))
WRITE !,"Date must be no earlier than "_$$FMTE^XLFDT(DGBEGIN,"D")
GOTO AGAIN
+3 QUIT Y
+4 ;
ASKINST(INST) ;
+1 ;Description: As the user to specify the divisions to report
+2 ;Input: none
+3 ;
+4 ;Output:
+5 ; Function Value - 0 on success, 1 on failure
+6 ; INST - array of institutions selected (pass by reference)
+7 ; subscripts:
+8 ; ("ALL")=1 if all selected, 0 otherwise
+9 ; (<ien of facility in instititution file>)=""
+10 ;
+11 NEW SUCCESS,DONE
+12 SET SUCCESS=1
SET DONE=0
+13 KILL INST
+14 ;
+15 ;ask if all facilities should be included
+16 Begin DoDot:1
+17 NEW DIR
+18 SET DIR(0)="YA"
+19 SET DIR("A")="Do you want the report for ALL facilities? "
+20 SET DIR("B")="YES"
+21 SET DIR("?")="The report will inlcude only selected instititutions, as determined by the patient's chosen preferred facility, if you select YES"
+22 DO ^DIR
+23 IF $DATA(DIRUT)
SET SUCCESS=0
QUIT
+24 SET INST("ALL")=Y
End DoDot:1
+25 ;
+26 ;if the user wants to select particular facilities, ask for list
+27 IF SUCCESS
IF 'INST("ALL")
FOR
if DONE
QUIT
if 'SUCCESS
QUIT
Begin DoDot:1
+28 NEW DIR
+29 SET DIR(0)="P^4:AEM"
+30 DO ^DIR
+31 IF +Y>0
SET INST(+Y)=""
+32 SET DIR(0)="YA"
+33 SET DIR("A")="Do you want to select another facility? "
+34 SET DIR("B")="YES"
+35 DO ^DIR
+36 IF $DATA(DIRUT)
SET SUCCESS=0
+37 IF Y=0
SET DONE=1
End DoDot:1
+38 QUIT SUCCESS
