source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRPB2.m@ 1133

Last change on this file since 1133 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1DGENRPB2 ;ALB/CJM - Pending Applications for Enrollment Report Cont.; May 4, 1998
2 ;;5.3;Registration;**147,232**;Aug 13,1993
3 ;
4PRINT ;
5 N STATS,CRT,QUIT,PAGE1
6 K ^TMP($J)
7 S QUIT=0
8 S PAGE1=1
9 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
10 ;
11 D GETPAT
12 U IO
13 I CRT,PAGE1 W @IOF S PAGE1=0
14 D HEADER
15 ;
16 D PRNTPATS
17 I CRT,'QUIT D PAUSE
18 I $D(ZTQUEUED) S ZTREQ="@"
19 D ^%ZISC
20 K ^TMP($J)
21 Q
22LINE(LINE) ;
23 ;Description: prints a line. First prints header if at end of page.
24 ;
25 I CRT,($Y>(IOSL-4)) D
26 .D PAUSE
27 .Q:QUIT
28 .W @IOF
29 .D HEADER
30 .W LINE
31 ;
32 E I ('CRT),($Y>(IOSL-2)) D
33 .W @IOF
34 .D HEADER
35 .W LINE
36 ;
37 E W !,LINE
38 Q
39 ;
40GETPAT ;
41 ;Description: Gets patients to include in the report
42 ;for that reason
43 ;
44 N DFN,STATUS,I,DGENRIEN,DGENR,EFFDATE
45 S STATUS=""
46 F S STATUS=$O(^DPT("AENRC",STATUS)) Q:STATUS="" D
47 .S DFN=0
48 .F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
49 ..S DGENRIEN=$$FINDCUR^DGENA(DFN)
50 ..Q:'$$GET^DGENA(DGENRIEN,.DGENR)
51 ..I $$CATEGORY^DGENA4(DFN)="P" D
52 ...;
53 ...N PREFAC,DGPFH,DGINST
54 ...S PREFAC=$$PREF^DGENPTA(DFN)
55 ...I PREFAC S DGPFH("PREFAC")=PREFAC,DGPFH("EFFDATE")=""
56 ...I PREFAC,'$$GETINST^DGENU($G(DGPFH("PREFAC")),.DGINST) S PREFAC=""
57 ...I (DGENINST("ALL")!$D(DGENINST(+PREFAC))),(DGENR("APP")>(DGENBEG-1)),(DGENR("APP")<(DGENEND+1)) D
58 ....S ^TMP($J,$$LJ($G(DGINST("STANUM")),10)_$$LJ($G(DGINST("NAME")),45),DGENR("STATUS"),DGENR("APP"),DGENRIEN)=$G(DGPFH("EFFDATE"))
59 Q
60 ;
61HEADER ;
62 ;Description: Prints the report header.
63 ;
64 N LINE
65 W !,"Pending Applications For Enrollment - Enrollment Category is ""In Process"""
66 W !,"Date Range: "_$$FMTE^XLFDT(DGENBEG)_" to "_$$FMTE^XLFDT(DGENEND)
67 W ?50," Run Date: "_$$FMTE^XLFDT(DT)
68 W !
69 W !,"AppDt",?17,"Name",?64,"PatientID",?81,"DOB"
70 S $P(LINE,"-",132)="-"
71 W !,LINE
72 Q
73 ;
74PAUSE ;
75 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
76 ;
77 N DIR,X,Y
78 F Q:$Y>(IOSL-3) W !
79 S DIR(0)="E" D ^DIR
80 I ('(+Y))!$D(DIRUT) S QUIT=1
81 Q
82 ;
83PRNTPATS ;
84 ;Description: Prints list of patients
85 ;
86 N PREFAC,APP,DGENRIEN,DGENR,DGPAT,LINE,STATUS
87 S PREFAC=""
88 F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
89 .D LINE(" ") Q:QUIT
90 .D LINE("PREFERRED FACILITY: "_$S('(+PREFAC):"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
91 .S STATUS=""
92 .F S STATUS=$O(^TMP($J,PREFAC,STATUS)) Q:STATUS="" D
93 ..D LINE(" ") Q:QUIT
94 ..D LINE(" ENROLLMENT STATUS: "_$$STATUS(STATUS)) Q:QUIT
95 ..S APP=""
96 ..F S APP=$O(^TMP($J,PREFAC,STATUS,APP)) Q:'APP D Q:QUIT
97 ...S DGENRIEN=0
98 ...F S DGENRIEN=$O(^TMP($J,PREFAC,STATUS,APP,DGENRIEN)) Q:'DGENRIEN D Q:QUIT
99 ....Q:'$$GET^DGENA(DGENRIEN,.DGENR)
100 ....Q:'$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
101 ....S LINE=$$LJ($$DATE(APP),12)_" "_$$LJ(DGPAT("NAME"),45)_" "
102 ....S LINE=LINE_$$LJ(DGPAT("PID"),15)_" "_$$LJ($$DATE(DGPAT("DOB")),12)
103 ....D LINE(LINE)
104 Q
105 ;
106STATUS(STATUS) ;
107 ;Description: Returns status name.
108 ;
109 Q $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
110 ;
111DATE(DATE) ;
112 Q $$FMTE^XLFDT(DATE,"1")
113 ;
114LJ(STRING,LENGTH) ;
115 Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
Note: See TracBrowser for help on using the repository browser.