source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCDXFU04.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: 8.1 KB
Line 
1SCDXFU04 ;ALB/JRP - ACRP FILE UTILITIES FOR CLOSE OUT;15-APR-97 ; 1/24/02 3:44pm
2 ;;5.3;Scheduling;**121,140,247**;Aug 13, 1993
3 ;
4XMIT4DBC(XMITPTR) ;Determine if an entry in the TRANSMITTED OUTPATIENT
5 ; ENCOUNTER file (#409.73) should be transmitted to the NPCD
6 ; for database [not workload] credit and/or workload credit
7 ;
8 ;Input : XMITPTR - Pointer to entry in Transmitted Outpatient
9 ; Encounter file
10 ;Output:
11 ; 0 - Transmit - NPCD will accept for monthly workload credit,
12 ; no message generated
13 ; 1 - Transmit - NPCD will accept for monthly workload credit
14 ; with a rolling message
15 ; 2 - Transmit - will accept for yearly workload report
16 ; 3 - Transmit - for historical accuracy of database only
17 ; 4 - Don't transmit (NPCD will not accept for database credit)
18 ;Notes :5 (don't transmit) will be returned on error/bad input
19 ;
20 ;Check input
21 S XMITPTR=+$G(XMITPTR)
22 Q:('$D(^SD(409.73,XMITPTR,0))) 5
23 ;Declare variables
24 N NODE,ENCPTR,DELPTR,ENCDATE
25 ;Get pointer to [deleted] encounter
26 S NODE=$G(^SD(409.73,XMITPTR,0))
27 S ENCPTR=+$P(NODE,"^",2)
28 S DELPTR=+$P(NODE,"^",3)
29 ;Get date/time of [deleted] encounter
30 S:(ENCPTR) NODE=$G(^SCE(ENCPTR,0))
31 S:('ENCPTR) NODE=$G(^SD(409.74,DELPTR,1))
32 S ENCDATE=+NODE
33 Q:('ENCDATE) 5
34 ;Get the level of acceptance
35 Q $$OKTOXMIT(ENCDATE)
36 ;
37OKTOXMIT(ENCDATE,COMPDATE) ;Determine if an encounter occurring on a
38 ; specified date should be transmitted to the National Patient Care
39 ; Database for database and workload credit. It also determines
40 ; the acceptance level(message type), later used when generating
41 ; late activity messages
42 ;
43 ;Input (FileMan format):
44 ;
45 ; ENCDATE - Date/time Outpatient Encounter occurred on
46 ; COMPDATE - Date to compare close out dates against;
47 ; defaults to the current date
48 ;
49 ;Output : MessageType
50 ;
51 ; MessageType - Indicates what type of message will be generated
52 ; for Encounter with the submitted ENCDATE.
53 ; In the same time the message type determines if
54 ; Encounter can be transmitted. The message type
55 ; indicates if the specified date/time will be
56 ; accepted for database/workload credit.
57 ;
58 ; A message type is determined in the following order of comparison:
59 ; Type Transmitted
60 ; -------------------------------------------------------------
61 ; 4 - Database closeout date no DBCLOSE
62 ; 3 - Annual Workload closeout date yes WLCLA
63 ; 2 - Monthly Workload closeout date yes WLCLOSE
64 ; 1 - Rolling date yes ROLL
65 ;
66 ; 0 - No message yes
67 ; -1 - Error no
68 ;
69 ;Check input / remove time
70 S ENCDATE=+$G(ENCDATE)\1
71 Q:(ENCDATE'?7N) "-1"
72 S COMPDATE=+$G(COMPDATE)\1
73 S:(COMPDATE'?7N) COMPDATE=$$DT^XLFDT()
74 ;Declare variables
75 N CLOSEOUT,DBCLOSE,WLCLOSE,WLCLA,ROLL
76 N DBCRED,WLCRED,COMP
77 S (DBCRED,WLCRED)=-1
78 ;Get close-out dates for month the encounter occurred in
79 S CLOSEOUT=$$CLOSEOUT(ENCDATE)
80 S DBCLOSE=$P(CLOSEOUT,U)
81 S WLCLOSE=$P(CLOSEOUT,U,2)
82 S WLCLA=$P(CLOSEOUT,U,3)
83 S ROLL=$P(CLOSEOUT,U,4)
84 ;Determine LEVEL to determine if an encounter can be transmitted
85 ;and identify a message to be generated
86 N LEVEL,X,%H,%T,%Y,YY
87 S LEVEL=0
88 S X=COMPDATE D H^%DTC S COMP=%H
89 F YY=4:-1:1 D Q:LEVEL
90 .S X=$S(YY=4:DBCLOSE,YY=3:WLCLA,YY=2:WLCLOSE,YY=1:ROLL) D
91 ..D H^%DTC I COMP>%H S LEVEL=YY
92 ;Done
93 Q LEVEL
94 ;
95CLOSEOUT(NPCDMNTH) ;Get National Patient Care Database (NPCD) close-out
96 ; dates for a given month
97 ;
98 ;Input : NPCDMNTH - Encouter Date (FileMan format) to calculate
99 ; close-out dates
100 ;Output: DBCL ^ WLCLM ^ WLCLA ^ ROLL
101 ; or -1 ^ -1 ^ -1 ^ -1^ - Error/bad input
102 ; DBCL,WLCLM,WLCLA,ROLL are returned in FileMan format.
103 ;
104 ;DBCL - Database closeout date
105 ; Date on which the specified date/time (NPCDMNTH) will no
106 ; longer be accepted by the NPCD
107 ;WLCLM - Monthly Workload closeout date
108 ; Date on which the specified date/time will no longer be
109 ; accepted by the NPCD for montly workload credit but will
110 ; be valid for fiscal year credit
111 ;WLCLA - Annual Workload closeout date
112 ; Date on which the specified date/time will no longer be
113 ; accepted for yearly credit but will be sent to NPCD for
114 ; historical accuracy of the database.
115 ;ROLL - NPCDMNTH+ROLLD
116 ; Date representing the date ROLLD days older than the
117 ; specified date/time.
118 ;
119 N DBCL,WLCLM,WLCLA,ROLL,SDY,SDM,SDMM,SDYM,DBCLMD,WLCLMD,WLCLAMD,ROLLD
120 N X1,X2,X,%H,%T,%Y,TODAY,SDYY
121 S DBCLMD="0930",WLCLMD=19,WLCLAMD=1019,ROLLD=19
122 ;
123 ;Check input / remove time
124 S NPCDMNTH=+$G(NPCDMNTH)\1
125 Q:(+NPCDMNTH'?7N) "-1^-1^-1^-1"
126 ;
127 ;Declare variables
128 S SDY=$E(NPCDMNTH,1,3)
129 S SDM=$E(NPCDMNTH,4,5)
130 ;
131 ;Build DBCL
132 S SDYY=SDY+2 S:SDM>9 SDYY=SDYY+1
133 S DBCL=SDYY_DBCLMD
134 ;
135 ;Build WLCLM
136 S SDMM=SDM+1,SDYM=SDY
137 I SDMM=13 S SDMM="01",SDYM=SDY+1
138 S:$L(SDMM)=1 SDMM="0"_SDMM
139 S WLCLM=SDYM_SDMM_WLCLMD
140 ;
141 ;Build WLCLA
142 I SDM>9 S SDY=SDY+1
143 S WLCLA=SDY_WLCLAMD
144 ;
145 ;Build ROLL
146 S X1=NPCDMNTH,X2=ROLLD D C^%DTC S ROLL=X
147 ;
148 Q DBCL_U_WLCLM_U_WLCLA_U_ROLL
149 ;
150AECLOSE(NPCDMNTH,DBCLOSE,WLCLOSE) ;Add/edit NPCD close-out dates for
151 ; entries in the NPCD ENCOUNTER MONTH multiple (field #710) of the
152 ; SCHEDULING PARAMETERS file (#404.91)
153 ;
154 ; This field (#710) is not used starting with SD*5.3*247.
155 ;
156 ;Input : NPCDMNTH - Month to add/edit National Patient Care Database
157 ; close-out dates (FileMan format)
158 ; DBCLOSE - Date on which the specified date/time will no
159 ; longer be accepted by the NPCD (FileMan format)
160 ; WLCLOSE - Date on which the specified date/time will no
161 ; longer be accepted by the NPCD for workload
162 ; credit (FileMan format)
163 ;Output : IEN ^ Added = Success
164 ; IEN = Pointer to entry in NPCD ENCOUNTER MONTH multiple
165 ; Added = Flag indicating if new entry was added
166 ; 1 = Yes 0 = No
167 ; -1 = Error/bad input
168 ;Notes : NPCDMNTH will be converted to an NPCD Encounter Month
169 ; : It is assumed that NPCDMNTH is a valid date
170 ;
171 ;Check input / remove time
172 S NPCDMNTH=$P((+$G(NPCDMNTH)),".",1)
173 Q:(NPCDMNTH'?7N) -1
174 S DBCLOSE=$P((+$G(DBCLOSE)),".",1)
175 Q:(DBCLOSE'?7N) -1
176 S WLCLOSE=$P((+$G(WLCLOSE)),".",1)
177 Q:(WLCLOSE'?7N) -1
178 ;Declare variables
179 N SCDXFDA,SCDXIEN,SCDXMSG,MNTHPTR,MNTHADD
180 ;Convert FileMan month to NPCD Encounter Month
181 S NPCDMNTH=$$FM2NPCD(NPCDMNTH)
182 Q:(NPCDMNTH=-1) -1
183 ;Set up call to FileMan Updater (call will find/create entry)
184 S SCDXFDA(404.9171,"?+1,1,",.01)=NPCDMNTH
185 S SCDXFDA(404.9171,"?+1,1,",.02)=DBCLOSE
186 S SCDXFDA(404.9171,"?+1,1,",.03)=WLCLOSE
187 ;Call FileMan Updater
188 D UPDATE^DIE("ES","SCDXFDA","SCDXIEN","SCDXMSG")
189 ;Error
190 Q:($D(SCDXMSG("DIERR"))) -1
191 ;Get entry number
192 S MNTHPTR=+$G(SCDXIEN(1))
193 ;Determine if new entry was added
194 S MNTHADD=0
195 S:($G(SCDXIEN(1,0))="+") MNTHADD=1
196 ;Done
197 Q MNTHPTR_"^"_MNTHADD
198 ;
199FM2NPCD(DATE) ;Convert FileMan date/time to NPCD ENCOUNTER MONTH format
200 ;
201 ;Input : DATE - Date/time to convert (FileMan format)
202 ;Output : MM-YYYY - Imprecise month format
203 ; MM = Month (numeric with leading zero)
204 ; YYYYY = Year
205 ; -1 - Error (bad input)
206 ;Notes : It is assumed that DATE is a valid date
207 ;
208 ;Check input
209 S DATE=+$P($G(DATE),".",1)
210 Q:(DATE'?7N) -1
211 ;Return NPCD Encounter Month
212 Q $E(DATE,4,5)_"-"_(1700+$E(DATE,1,3))
213 ;
214NPCD2FM(NPCDMNTH) ;Convert NPCD ENCOUNTER MONTH format to FileMan date
215 ;
216 ;Input : MM-YYYY - Imprecise month format
217 ; MM = Month (numeric with leading zero)
218 ; YYYYY = Year
219 ;Output : DATE - Date/time to convert (FileMan format)
220 ; -1 - Error (bad input)
221 ;Notes : It is assumed that NPCDMNTH is a valid imprecise date
222 ;
223 ;Check input
224 S NPCDMNTH=$G(NPCDMNTH)
225 Q:(NPCDMNTH'?2N1"-"4N) -1
226 ;Return FileMan date
227 ;Q ($P(NPCDMNTH,"-",2)-1700)_$P(NPCDMNTH,"-",1)_"00"
228 ; Y2K Renovation. %DT will return yyymm00 for imprecise date.
229 N X,Y S X=NPCDMNTH D ^%DT
230 Q Y
Note: See TracBrowser for help on using the repository browser.