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

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1DGEN1 ;ALB/RMO - Patient Enrollment Protocols;16 JUN 1997 01:30 pm
2 ;;5.3;Registration;**121,147,624**;08/13/93
3 ;
4EP ;Entry point for DGEN ENROLL PATIENT protocol
5 ; Input -- DFN Patient IEN
6 ; Output -- VALMBCK R =Refresh screen
7 ;
8 ;send an enrollment/eligibility query
9 I $$SEND^DGENQRY1(DFN) W !!,"Enrollment/Eligibility Query sent...",!!
10 ;
11 N DGENOUT
12 S VALMBCK=""
13 D FULL^VALM1
14 ;
15 ;Enroll patient
16 I '$$ENRPAT^DGEN(DFN,.DGENOUT) D
17 . I '$G(DGENOUT) D
18 . . W !!,">>> Patient enrollment record was not created."
19 . . D PAUSE^VALM1
20 ELSE D
21 . ;Re-build enrollment screen
22 . D BLD^DGENL
23 D MESSAGE^DGENL(DFN)
24 S VALMBCK="R"
25 Q
26 ;
27CE ;Entry point for DGEN CEASE ENROLLMENT protocol
28 ; Input -- DFN Patient IEN
29 ; Output -- VALMBCK R =Refresh screen
30 N DGENOUT,DGENR,DGENRIEN
31 S VALMBCK=""
32 D FULL^VALM1
33 ;
34 ;Ask patient if s/he would like to cease enrollment
35 I $$ASK^DGEN("cease enrollment",.DGENOUT) D
36 . ;If 'Yes' cancel current enrollment
37 . ;Find current enrollment
38 . S DGENRIEN=$$FINDCUR^DGENA(DFN) Q:'DGENRIEN
39 . ;Get current enrollment array
40 . I $$GET^DGENA(DGENRIEN,.DGENR) D
41 . . ;Cancel current enrollment
42 . . I '$$CANCEL^DGEN(DFN,.DGENR) D
43 . . . W !!,">>> Patient's enrollment was not ceased."
44 . . . D PAUSE^VALM1
45 . . ELSE D
46 . . . ;Re-build enrollment screen
47 . . . D BLD^DGENL
48 D MESSAGE^DGENL(DFN)
49 S VALMBCK="R"
50 Q
51 ;
52EH ;Entry point for DGEN EXPAND HISTORY protocol
53 ; Input -- DFN Patient IEN
54 ; Output -- VALMBCK R =Refresh screen
55 N DGI,DGSELY
56 S VALMBCK=""
57 ;
58 ;Select entries to expand
59 D EN^DGENLR(XQORNOD(0),"EH",.DGSELY)
60 I $D(DGSELY("^"))!($D(DGSELY("ERR"))) G EHQ
61 D FULL^VALM1
62 ;
63 ;Expand history for selected entries
64 S DGI=0
65 ;Loop through selection
66 F S DGI=$O(DGSELY(DGI)) Q:'DGI D
67 . N DGLINE,DGENRIEN
68 . S DGLINE=+$O(^TMP("DGENIDX",$J,"EH",DGI,0)),DGENRIEN=+$G(^(DGLINE))
69 . W !!,^TMP("DGEN",$J,DGLINE,0)
70 . ;Load patient enrollment history screen
71 . D EN^DGENLEH(DFN,DGENRIEN)
72 D MESSAGE^DGENL(DFN)
73 S VALMBCK="R"
74EHQ Q
75 ;
76SP ;Entry point for DGEN SELECT PATIENT protocol
77 ; Input -- None
78 ; Output -- DFN Patient IEN
79 ; VALMBCK R =Refresh screen
80 N DGDFN
81 S VALMBCK=""
82 D FULL^VALM1
83 ;
84 ;Get Patient File (#2) IEN
85 D GETPAT^DGRPTU(,,.DGDFN,)
86 ;
87 ;If a patient is selected
88 I DGDFN>0 D
89 . ;Reset DFN to selected patient
90 . S DFN=DGDFN
91 . ;Re-build enrollment screen for selected patient
92 . D BLD^DGENL
93 D MESSAGE^DGENL(DFN)
94 S VALMBCK="R"
95SPQ Q
96 ;
97QUERY ;entry point for DGEN SEND ENROLLMENT QUERY protocol
98 I '$$ON^DGENQRY W "sending of enrollment queries turned off" Q
99 N NOTIFY,DIR,ERROR
100 S DIR("A")="Do you want to be notified when the reply is received"
101 S DIR("B")="YES"
102 S DIR(0)="Y"
103 S DIR("?")="If YES, you will be mailed notification when the reply is received."
104 D ^DIR
105 I '$D(DIRUT) D
106 .K DIR
107 .I Y=1 S NOTIFY=$G(DUZ)
108 .I $$SEND^DGENQRY1(DFN,$G(NOTIFY),,.ERROR) D
109 ..W !!,"Enrollment/Eligibility query sent ..."
110 .E D
111 ..W !!,"Failure to send Query: ",ERROR
112 .D PAUSE^VALM1
113 D MESSAGE^DGENL(DFN)
114 S VALMBCK="R"
115 Q
116 ;
117CHECK ;Entry point for the DGEN CHECK QUERY STATUS protocol
118 I $$PENDING^DGENQRY(DFN) D
119 .W !!,"Query still pending ..."
120 .D PAUSE^VALM1
121 .D MESSAGE^DGENL(DFN)
122 E D
123 .W !!,"Query is not pending ..."
124 .D PAUSE^VALM1
125 .D BLD^DGENL
126 S VALMBCK="R"
127 Q
128 ;
129PEZ ;Entry point for DGENUP PRINT 1010EZ-EZR protocol (DG*5.3*624)
130 N RPTSEL,DGTASK,MTIEN
131 D FULL^VALM1
132 S (RPTSEL,DGTASK,MTIEN)=""
133 S RPTSEL=$$SEL1010^DG1010P("") ;*Select 1010EZ/R form to print
134 D:RPTSEL'="-1"
135 .S MTIEN=$$MTPRMPT^DG1010P(DFN,"") ;select mt to print
136 .S DGTASK=$$PRT1010^DG1010P(RPTSEL,DFN,MTIEN) ;*Print 1010EZ/R
137 S VALMBCK="R"
138 Q
Note: See TracBrowser for help on using the repository browser.