source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SD53P491.m@ 623

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

initial load of WorldVistAEHR
File size: 9.6 KB
Line 
1SD53P491 ;ALB/ESW - SD*5.3*491 POST INIT; Oct 04, 2006 ; 10/23/06 5:40pm ; Compiled June 17, 2008 10:41:32
2 ;;5.3;SCHEDULING;**491**;AUG 13, 1993;Build 53
3 ;Remove trigger - field .01 in the SD WL CLINIC LOCATION file (# 409.32)
4 ;Verify setup of Billable Appointment type: ein=11 - SC
5 ;Update encounters with Appointment Type matching the SC set up on the encounter level
6 ;Update file 409.32 and 409.3 with proper institution set up
7 ;Retransmission of updated encounters has been disabled
8 Q
9 ;
10POST ;
11 N SDA
12 S SDA(1)="",SDA(2)=" SD*5.3*491 Post-Install .....",SDA(3)="" D ATADDQ
13 N SDA
14 S SDA(1)="",SDA(2)=" Deleting cross-reference definition - trigger of the CLINIC field"
15 S SDA(3)=" in the SD WL CLINIC LOCATION file (# 409.32)",SDA(4)=""
16 D DELIX^DDMOD(409.32,.01,2,"K") D ATADDQ
17 ;
18 D ATADD ; Verify Billable Appointment Type: ien=11
19 ; ^IBE(352.1,11,0)=11^11^2880101^0^1^1
20 S SDA(1)="",SDA(2)=" SD*5.3*491 SC Billable Appointment Type error checking is complete",SDA(3)="" D ATADDQ
21 N SDA
22 S SDA(1)="",SDA(2)="Starting Appointment Type verification for Outpatient Encounter file entries",SDA(3)="with encounter-level Service Connection for encounter entries created",SDA(4)="Jan 20, 2006 or later",SDA(5)="" D ATADDQ
23 ;
24 D CHKSC
25 N SDA
26 S SDA(1)="",SDA(2)="Appointment Type correction to file 409.68 and to sub-file 2.98 finished.",SDA(3)="" D ATADDQ
27 ;
28 N SDA
29 S SDA(1)="",SDA(2)="Checking file 409.32 and 409.3 for valid national institutions, and pointers",SDA(3)="that don't match institutions of the Medical Center Division of their related",SDA(4)="Hospital Location",SDA(5)="" D ATADDQ
30 N INERROR,SDWLSC,SDX,CNT S INERROR=""
31 S SDX(1)="Checking file 409.32 and 409.3 for valid national institutions, and pointers"
32 S SDX(2)="that don't match institutions of the Medical Center Division of their related"
33 S SDX(3)="Hospital Location"
34 S SDX(4)="",CNT=4 S SDWLSC=0 F S SDWLSC=$O(^SDWL(409.32,SDWLSC)) Q:'SDWLSC D UPDINS(SDWLSC,.CNT,.INERROR)
35 D MSGG(.SDX)
36 Q:INERROR
37 N DIK S DIK="SDWL(409.32," D IXALL^DIK
38 N SDA
39 S SDA(1)="",SDA(2)="Verification and update of files 409.32 and 409.3",SDA(3)=" with proper institution finished.",SDA(4)="",SDA(5)=" SD*5.3*491 Post-Install finished...."
40 D ATADDQ
41 Q
42 ;
43ATADD ; New Billable Appointment Type (352.1) to correspond to the New 'SERVICE CONNECTED' Appointment Type (409.1)
44 N DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,SDA,IBFOUND,SDATFN,IBNUM,SDAT,IBFN
45 S SDA(1)=" >> Verifying 'Service Connected' Billable Appointment Type (#352.1)"
46 S (SDATFN,IBNUM)=11,SDAT="SERVICE CONNECTED"
47 S IBFOUND=$G(^IBE(352.1,SDATFN,0)) ; new IA confirmed to be created
48 I IBFOUND="11^11^2880101^0^1^1" D D ATADDQ Q
49 .D MSG(" Done. Billable Appointment Type Service Connected is set up properly")
50 D MSG(" "),MSG("* ERROR IN CONFIGURATION OF ENTRY IEN=11 IN FILE 352.1 *")
51 D MSG("IT IS MANDATORY THAT YOU CREATE AN INTEGRATED BILLING REMEDY TICKET"),MSG("Entry 11 should be configured for the SERVICE CONNECTED appointment type.")
52 D MSG(" --------------------------") D ATADDQ
53 Q
54ATADDQ D MES^XPDUTL(.SDA) K SDA
55 Q
56CHKSC ;Match SC encounter value with proper Appointment Type.
57 ; look for encounters only
58 N SCE,CNT,CNTA S CNT=0,CNTA=0
59 ;SCE - EIN of Outpatient Encounter
60 K ^XTMP("SD53P491-"_$J),^XTMP("SD53P491AP-"_$J)
61 S ^XTMP("SD53P491-"_$J,0)=$$FMADD^XLFDT(""_DT_"",7)_U_DT
62 S ^XTMP("SD53P491AP-"_$J,0)=$$FMADD^XLFDT(""_DT_"",7)_U_DT
63 S SCE=0
64 F S SCE=$O(^SCE(SCE)) Q:SCE'>0 I $P($G(^SCE(SCE,"USER")),U,4)>3060120 D
65 .N STR,SDSCV,SDT,SDVST,DFN,SDAPDF,SDVSCL S STR=$G(^SCE(SCE,0))
66 .S DFN=$P(STR,U,2),SDT=+STR,SDVSCL=$P(STR,U,4)
67 .S SDVST=$P($G(STR),U,5)
68 .Q:'SDVST Q:'$D(^AUPNVSIT(SDVST,800))
69 .S SDSCV=$$GET1^DIQ(9000010,SDVST_",",80001,"I") ;SC flag in Visit file
70 .Q:SDSCV="" ;do not proceed if SC not determined
71 .S SDAPDF=$$GET1^DIQ(44,SDVSCL_",",2507,"I") ;default appt type
72 .I SDAPDF'="" S SDAPDPT=SDAPDF ; set to default if exists for this clinic
73 .E S SDAPDPT=9 ; set to regular
74 .N UPDAP I SDSCV S UPDAP=11
75 .E S UPDAP=SDAPDPT
76 .N SDR D APPT(DFN,SDT,SCE,UPDAP,.SDR)
77 .I $P(^SCE(SCE,0),U,10)=11 D ; change only if original appt type was SC
78 ..Q:SDSCV
79 ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SCE)=^SCE(SCE,0) S CNT=CNT+1
80 ..S $P(^SCE(SCE,0),U,10)=SDAPDPT
81 ..;I 'SDR D RETR(SCE)
82 .E D
83 ..Q:'SDSCV
84 ..; change only if original appt type was SC
85 ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SCE)=^SCE(SCE,0) S CNT=CNT+1
86 ..S $P(^SCE(SCE,0),U,10)=11
87 ..;I 'SDR D RETR(SCE)
88 .D CRST(SDVST,SDSCV,SDAPDPT,.CNT)
89 N SDA
90 S SDA(1)="",SDA(2)=" "_CNT_" OUTPATIENT ENCOUNTER entry(ies) updated with an Appointment Type."
91 S SDA(3)=" "_CNTA_" APPOINTMENT Multiple entry(ies) in the PATIENT file updated"
92 S SDA(4)=" "_"with an Appointment Type."
93 S SDA(5)=""
94 D ATADDQ
95 Q
96APPT(DFN,SDT,SCE,UPDAP,SDR) ;update appointment multiple in Patient file
97 N STR S STR=$G(^DPT(DFN,"S",SDT,0))
98 S SDR=0
99 I $P(STR,U,20)'=SCE Q
100 I $P(STR,U,16)'=UPDAP D
101 .M ^XTMP("SD53P491AP-"_$J,DFN,SDT,SCE)=STR
102 .S $P(^DPT(DFN,"S",SDT,0),U,16)=UPDAP
103 .S CNTA=CNTA+1,SDR=1
104 .;I SDR D RETR(SCE)
105 Q
106RETR(SCE) ; mark encounter for retransmission
107 N SDXM
108 S SDXM=$$FINDXMIT^SCDXFU01(SCE)
109 D STREEVNT^SCDXFU01(SDXM,2)
110 D XMITFLAG^SCDXFU01(SDXM)
111 Q
112MSG(X) ;
113 N SDX S SDX=$O(SDA(999999),-1) S:'SDX SDX=1 S SDX=SDX+1
114 S SDA(SDX)=$G(X)
115 Q
116CRST(SDVST,SDSCV,SDAPDPT,CNT) ;check for credit stop encounter for each scanned encounter
117 N SDVSTS,SDE S SDE="" S SDVSTS=$O(^AUPNVSIT("AD",SDVST,"")) ; only one child visit
118 I SDVSTS>0 S SDE=$O(^SCE("AVSIT",SDVSTS,""))
119 Q:'SDE
120 I SDSCV D
121 .I $P(^SCE(SDE,0),U,10)'=11 D
122 ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SDE,1)=^SCE(SDE,0) S CNT=CNT+1
123 ..S $P(^SCE(SDE,0),U,10)=11
124 ..;D RETR(SDE)
125 I 'SDSCV D
126 .I $P(^SCE(SDE,0),U,10)=11 D
127 ..M ^XTMP("SD53P491-"_$J,DFN,SDT,SDE,1)=^SCE(SDE,0) S CNT=CNT+1
128 ..S $P(^SCE(SDE,0),U,10)=SDAPDPT
129 ..;D RETR(SDE)
130 Q
131UPDINS(SDWLSC,CNT,INERROR) ; update 409.32 and the related entries in 409.3
132 N SDWLINS S SDWLINS=$$GET1^DIQ(409.32,SDWLSC_",",.02,"I") ; current set up IN 409.32
133 ;check set up in file 44
134 ;get clinic
135 N CL,CLN S CL=$$GET1^DIQ(409.32,SDWLSC_",",.01,"I"),CLN=$$GET1^DIQ(44,CL_",",.01)
136 N STR,SDWMES S SDWMES="",STR=$$CLIN^SDWLPE(CL)
137 S SDWMES=SDWMES_$P(STR,U,6)
138 I $P(STR,U,5)="L" S CNT=CNT+1 S (SDWMES,SDX(CNT))=SDWMES_" - Local Institution assigned to clinic. "
139 I SDWMES'="" D Q
140 .S CNT=CNT+1,SDX(CNT)=" ** Invalid configuration of Clinic "_CLN_" ("_CL_")"_": **"
141 .W !!,SDX(CNT)
142 .S CNT=CNT+1,SDX(CNT)=SDWMES
143 .W !,SDX(CNT)
144 .S CNT=CNT+1,SDX(CNT)="YOU MUST UPDATE THIS FILE 44 ENTRY'S DIVISION OR ITS MEDICAL CENTER DIVISION'S"
145 .W !,SDX(CNT)
146 .S CNT=CNT+1,SDX(CNT)="INSTITUTION FILE POINTER."
147 .W !,SDX(CNT)
148 .S CNT=CNT+1,SDX(CNT)=""
149 .S:INERROR="" INERROR=1 Q
150 I +STR'=SDWLINS D
151 .S CNT=CNT+1,SDX(CNT)="The Medical Center Division for file 44 Clinic "_CLN_" ("_CL_")"
152 .W !!,SDX(CNT)
153 .S CNT=CNT+1,SDX(CNT)="has a different Institution than the file 409.32 entry for EWL."
154 .W !,SDX(CNT)
155 .N SDI,SDI1 S SDI=$$GET1^DIQ(4,SDWLINS_",",.01),SDI1=$$GET1^DIQ(4,SDWLINS_",",99)
156 .S CNT=CNT+1,SDX(CNT)="EWL Clinic INSTITUTION: "_SDI_" - "_SDI1
157 .W !,SDX(CNT)
158 .S CNT=CNT+1,SDX(CNT)="Clinic INSTITUTION: "_$P(STR,U,3)_" - "_$P(STR,U,2)
159 .W !,SDX(CNT)
160 .N DIE,DR,DA S DR=".02////^S X=+STR",DIE="^SDWL(409.32,",DA=SDWLSC
161 .L +^SDWL(409.32,DA):0 I '$T S CNT=CNT+1,SDX(CNT)="Entry locked; Run SD WAIT LIST CLEANUP later" W !?5,SDX(CNT) Q
162 .D ^DIE L -^SDWL(409.32,DA)
163 .S CNT=CNT+1,SDX(CNT)="Updated EWL Clinic to match."
164 .W !,SDX(CNT),!
165 .S CNT=CNT+1,SDX(CNT)=""
166 .;loop to update EWL entries in FILE 409.3 if any
167 .N SCL,DA,DR,CNT1 S SCL="",CNT1=0 F S SCL=$O(^SDWL(409.3,"SC",CL,SCL)) Q:SCL'>0 D
168 ..I '$D(^SDWL(409.3,SCL,0)) K ^SDWL(409.3,"SC",CL,SCL) Q
169 ..S DR="2////^S X=+STR",DIE="^SDWL(409.3,",DA=SCL
170 ..L +^SDWL(409.3,SCL):0 I '$T S CNT=CNT+1,SDX(CNT)="Entry locked; Run SD WAIT LIST CLEANUP later" W !?5,SDX(CNT),! Q
171 ..D ^DIE L -^SDWL(409.3,SCL) S CNT1=CNT1+1
172 .I CNT1>0 W !,CNT1_" wait list entry(ies) for "_CLN_" clinic updated in SD WAIT LIST file #409.3." S CNT=CNT+1,SDX(CNT)=""
173 N DA I $$GET1^DIQ(409.32,SDWLSC_",",3,"I")="" I $$GET1^DIQ(409.32,SDWLSC_",",1,"I")'>0 D
174 .S DA=SDWLSC L +^SDWL(409.32,SDWLSC):0 I '$T S CNT=CNT+1,SDX(CNT)="Entry locked; Run SD WAIT LIST CLEANUP later" W !?5,SDX(CNT) Q
175 .S DR="1////^S X=DT;2////^S X=DUZ",DIE="^SDWL(409.32," ;enter activation date and user
176 .D ^DIE L -^SDWL(409.32,SDWLSC)
177 .S CNT=CNT+1,SDX(CNT)="EWL Clinic entry for "_CLN_" updated with today's activation date."
178 .W !,SDX(CNT)
179 .S CNT=CNT+1,SDX(CNT)=""
180 Q
181MSGG(SDX) ;send message
182 N SDAMX,XMSUB,XMY,XMTEXT,XMDUZ,DIFROM
183 S XMSUB="PATCH SD*5.3*491 POST-INSTALL: UPDATE FILES 409.3 and 409.32"
184 S XMY("G.SD EWL BACKGROUND UPDATE")=""
185 S XMY(DUZ)=""
186 S XMTEXT="SDX("
187 S CNT=$O(SDX(""),-1)
188 S CNT=CNT+1,SDX(CNT)=""
189 S CNT=CNT+1,SDX(CNT)="SD WL CLINIC LOCATION file update is finished."
190 W !!,SDX(CNT)
191 S CNT=CNT+1,SDX(CNT)="Open EWL entries in the SD WAIT LIST file have also been updated."
192 W !,SDX(CNT)
193 S CNT=CNT+1,SDX(CNT)="If invalid/local Institution pointers were indicated above for"
194 W !!,SDX(CNT)
195 S CNT=CNT+1,SDX(CNT)="Hospital Location file #44, correct the DIVISION on those clinics"
196 W !,SDX(CNT)
197 S CNT=CNT+1,SDX(CNT)="and/or the INSTITUTION FILE POINTER of the Medical Center Division"
198 W !,SDX(CNT)
199 S CNT=CNT+1,SDX(CNT)="that the clinic points to, then run option SD WAIT LIST CLEANUP"
200 W !,SDX(CNT)
201 S CNT=CNT+1,SDX(CNT)="which will update institutions in EWL files 409.32 and 409.3."
202 W !,SDX(CNT)
203 S CNT=CNT+1,SDX(CNT)=""
204 W !,SDX(CNT)
205 S CNT=CNT+1,SDX(CNT)="NOTE: SD WAIT LIST CLEANUP must be run any time corrections are made to"
206 W !,SDX(CNT)
207 S CNT=CNT+1,SDX(CNT)="a Hospital Location file #44 entry's DIVISION or to an INSTITUTION FILE POINTER"
208 W !,SDX(CNT)
209 S CNT=CNT+1,SDX(CNT)="in the Medical Center division file #40.8."
210 W !,SDX(CNT)
211 D ^XMD
Note: See TracBrowser for help on using the repository browser.