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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1DGPREP1 ;ALB/SCK - Program to Display Pre-Registration List Cont. 1 ; 12/9/03 3:22pm
2 ;;5.3;Registration;**109,136,574**;Aug 13, 1993
3 Q
4EH ; Edit call log information
5 ; Variables
6 ; PTIFN - Patients IEN returned form the SELPAT procedure
7 ;
8 N PTIFN,D,X,DA,DR
9 S PTIFN=""
10 D SELPAT
11 Q:'$D(PTIFN)
12 S DIC="^DGS(41.43,",DIC(0)="EQZ"
13 S X=PTIFN,D="C"
14 S DIC("A")="Select LOG ENTRY: "
15 S DIC("S")="I $P(^(0),U,2)=PTIFN"
16 ;
17 D IX^DIC K DIC
18 ;
19 I Y>0 D
20 . S DA=+Y
21 . S DIE="^DGS(41.43,"
22 . S DR="3;2///^S X=$P(^VA(200,DUZ,0),U)"
23 . D ^DIE K DIE
24 . I '$D(Y) D
25 .. S DGPDFN=PTIFN
26 .. D BLDHIST^DGPREP0
27 .. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110)
28 .. S X=$$SETFLD^VALM1(DGPTAT,X,"HIST")
29 .. S ^TMP("DGPRERG",$J,DGPCH,0)=X
30 S VALMBCK="R"
31 Q
32 ;
33SELPAT ; Select patient if no patient is passed in
34 N VALMI,VALMAT,VALMY,X
35 D FULL^VALM1
36 D EN^VALM2(XQORNOD(0),"S") S VALMI=0
37 I '$D(VALMY) S VALMBCK="R" Q
38 S DGPN1="",DGPCH=$O(VALMY(DGPN1))
39 S PTIFN="",PTIFN=$O(^TMP("DGPRERG",$J,"DFN",DGPCH,PTIFN))
40 Q
41 ;
42EDIT ; Edit Patient Information
43 ; Variables
44 ; DGPDIV - Division IEN from ^TMP
45 ; DGPSTMP - Date/Time stamp from UPDLOG function
46 ; DGPIFN - Patients IEN from ^TMP
47 ; DGPP1-3,5 - Local Var's for $O
48 ; DGPNEW -
49 ; DGPFLG - Flag used to indicate a connect status of 'C'
50 ; DGPST - Call status returned by SELST function
51 ; DGPDA - IEN of Call log entry returned from UPDLOG function
52 ; DGPCH - Entry in the VALMY, selected entries, array
53 ;
54 N VALMI,VALMAT,VALMY,X,DGPN5,DGPDIV,DGPSTMP,DGPIFN,DGPP1,DGPP2,DGPP3,DGPNEW,DGPFLG
55 ;
56 D FULL^VALM1
57 D EN^VALM2(XQORNOD(0),"S") S VALMI=0
58 I '$D(VALMY) S VALMBCK="R" Q
59 S DGPN1="",DGPCH=$O(VALMY(DGPN1))
60 S DGPIFN="",DGPIFN=$O(^TMP("DGPRERG",$J,"DFN",DGPCH,DGPIFN))
61 S DGPDIV="",DGPDIV=$O(^TMP("DGPRERG",$J,"DIV",DGPCH,DGPDIV))
62 S DGNEW=0,DGPFLG=0
63 ;
64 ; *** Check patient sensitivity before proceeding
65 S DIC=2,DIC(0)="ENQ",X=DGPIFN D ^DIC K DIC
66 Q:Y<0
67 ;
68 ; *** Check lock status before continuing
69 S DGPN5="",DGPN5=$O(^DGS(41.42,"B",DGPIFN,DGPN5))
70 I DGPN5]"" L +^DGS(41.42,DGPN5):2 I '$T W *7,!,"Another User is Editing this Patient" S VALMBCK="R" Q
71 ;
72 S (DA,DFN)=DGPIFN
73 ;
74 S DGPFLG=1
75 S DGPSTMP=""
76 D INITLE(.DGPSTMP)
77 ;
78 I DGPCH]""&(DGPFLG) D
79 . S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110)
80 . ;S X=$$SETSTR^VALM1("*",X,8,1)
81 . I $G(DGPSTMP)]"" S X=$$SETSTR^VALM1($$FMTE^XLFDT(DGPSTMP,"2D"),X,70,8)
82 . S ^TMP("DGPRERG",$J,DGPCH,0)=X
83 . S DIE="^DGS(41.42,",DA=DGPN5
84 . S DR="4///Y" I DGPSTMP]"" S DR=DR_";3///^S X=DGPSTMP"
85 . D ^DIE K DIE
86 L -^DGS(41.42,DGPN5)
87 K DGPENT,DGPN1,DGPCH,DGPLOC,DGPST,DGPN5,DGPFLG
88 Q
89 ;
90INITLE(DGPY) ; Initialize for Load/Edit
91 ; Variables
92 ; Input:
93 ; DGPY - Null value
94 ;
95 ; Returns:
96 ; DGPY - Returns the date/time stamp entered into ^DGS(41.41,.
97 ;
98 ; Local:
99 ; DGPRFLG - This flag is used by the Patient Load/Edit routines
100 ; to indicate they were called by preregistration
101 ; DGPLOC - Flag used by DG10 to indicate preselection of a patient
102 ;
103 N DGPRFLG
104 S (DGPRFLG,DGPLOC)=1
105 W !!
106 D ^DG10
107 Q:$G(DGPFLG)&($G(DGRPOUT))
108 ;
109 S DGPST=$$SELST
110 I DGPST']"" S VALMBCK="R" Q
111 ;
112 I DGPST'="L" D
113 . S DGPDA=$$UPDLOG(DGPIFN,DGPST,DGPDIV) Q:DGPDA'>0
114 . I '$G(DGMODE),$P($G(^DGS(41.43,DGPDA,0)),U,4)]"" D
115 .. S X=$$SETSTR^VALM1(^TMP("DGPRERG",$J,DGPCH,0),"",1,110)
116 .. S DGPP1=$E(X,1,34),DGPP2=$E(X,35,38),DGPP3=$E(X,39,110)
117 .. S DGPP2=$P(^DGS(41.43,DGPDA,0),U,4)_DGPP2
118 .. S X=DGPP1_$E(DGPP2,1,4)_DGPP3
119 .. S ^TMP("DGPRERG",$J,DGPCH,0)=X
120 ;
121 W !
122 S DIR(0)="YA",DIR("A")="Date/Time stamp this patient? ",DIR("B")="YES"
123 D ^DIR K DIR
124 W !
125 I Y D
126 . K DD,DO
127 . S DGPY=$$NOW^XLFDT
128 . S DIC="^DGS(41.41,",DIC(0)="EQZ",X=DFN
129 . S DIC("DR")="1///^S X=DGPY;2////^S X=DUZ"
130 . D FILE^DICN
131 . K DIC
132 ;
133 Q
134STAT ; Display call history
135 K PTIFN D SELPAT
136 I $D(PTIFN) D
137 . D EN^DGPREP2
138 K PTIFN
139 Q
140 ;
141SELST() ; Function to select status for call log
142 ; Returns:
143 ; Status code as a SOC
144 ;
145 K DIRUT
146 N DIR
147 W !!
148 S DIR(0)="41.43,3"
149 S DIR("A")="STATUS OF CALL",DIR("B")="CONNECTED"
150 S DIR("?",1)="Enter the status of the current call from the list below."
151 S DIR("?")="Entries must be in uppercase, and match on of these codes."
152 D ^DIR K DIR
153 Q $G(Y)
154 ;
155UPDLOG(DFN,DGPS,DGPDV) ; Update PRE-REGISTRATION CALL LOG File, #41.43
156 ;
157 ; Variables
158 ; Input:
159 ; DFN - The IEN of the patient being called
160 ; DGPS - Status of the call attempt
161 ; DGPDV - Division IEN (used for sorting)
162 ;
163 ; Returns:
164 ; The IEN of the CALL LOG, File #41.43, entry that was added.
165 ; 0 is returned if the user ^'s out.
166 ;
167 K DD,DO
168 S DIC="^DGS(41.43,"
169 S DIC(0)="L"
170 S X=$$NOW^XLFDT
171 D FILE^DICN
172 I Y<0 W *7,"Problem adding to file - PRE-REGISTRATION CALL LOG"
173 I Y'<0 D
174 . S DIE="^DGS(41.43,"
175 . S DR="1////^S X=DFN;2////^S X=DUZ;3///^S X=DGPS;5////^S X=$S(+DGPDV>0:DGPDV,1:"""")"
176 . S DA=+Y
177 . D ^DIE K DIE
178 . I $D(Y) D
179 .. S DIK="^DGS(41.43," D ^DIK K DIK
180 Q +$G(DA)
181 ;
182DIREDT ; Direct edit of a patient in the PRE-REGISTRATION CALL LIST, bypassing the call list.
183 ;
184 ; Variables
185 ; DFN - Patients IEN, set for Load/Edit
186 ; DGPDIV - Division IEN from File #41.42
187 ; DGPST - Call Status
188 ; DGPIDX - Call List IEN, File #41.42
189 ; DGPFLG - Flag for direct patient edit, used for setting 'called' status
190 ; DGPSTMP - Date/time stamp
191 ;
192 N DFN,DGPDIV,DGPST,DGPIDX,DGPFLG,DGNEW,DGPXX,DGPSTMP,DGPX,DGPIFN,DGMODE
193 N DGRPOUT
194 ;
195 K DTOUT,DUOUT,DIC
196 S DIC=2,DIC(0)="AEQZM"
197 S DIC("A")="Select Patient to Preregister: "
198 S DIC("?")="Select a patient whose preregistration information you want to edit."
199 D ^DIC K DIC
200 I $D(DTOUT)!($D(DUOUT))!(Y<0) Q
201 ;
202 S (DFN,DGPIFN)=+Y,DGPIDX=""
203 I $D(^DGS(41.42,"B",DFN)) D Q:$G(DGPX)
204 . S DGPIDX=$O(^DGS(41.42,"B",DFN,DGPIDX))
205 . S DGPDIV=$P($G(^DGS(41.42,DGPIDX,0)),U,2)
206 . I DGPIDX]"" L +^DGS(41.42,DGPIDX):2 I '$T W *7,!,"Another user is editing this patient." S DGPX=1
207 ;
208 S DGNEW=0,DGPFLG=1,DGPSTMP="",DGMODE=1
209 ;
210 ; ** Since this is a direct call for a patient, and the particular appt. is not known, set DGPDIV to primary medical center division.
211 I $G(DGPDIV)']"" D
212 . S DGPDIV=$$PRIM^VASITE
213 ;
214 D INITLE(.DGPSTMP)
215 ;
216 I $G(DGRPOUT) G UNLCK
217 ;
218 I $G(DGPFLG),DGPIDX]"" D
219 . S DA=DGPIDX
220 . S DIE="^DGS(41.42,"
221 . S DR="4///Y" I DGPSTMP]"" S DR=DR_";3///^S X=DGPSTMP"
222 . D ^DIE K DIE
223 ;
224UNLCK I $G(DGPIDX)]"" L -^DGS(41.42,DGPIDX)
225 Q
Note: See TracBrowser for help on using the repository browser.