source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SD53430P.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1SD53430P ;WOIFO/CLC - PFSS Scheduled Outpatient Conversion Backload ;22-APR-2005
2 ;;5.3;Scheduling;**430**;Aug 13, 1993
3 D HDR
4 Q
5 ;
6PRECHK ;
7 N VCNT
8 D HDR W !!,"Pre-Backload Analysis - Outpatient future appointments."
9 S VCNT=$$FUTRAPP(0)
10 I VCNT<0 W !,"Analysis exited without processing..." Q
11 W !!,VCNT," Outpatient future appointments identified in VistA..."
12 W !!,"Analysis complete...."
13 Q
14FUTRAPP(CMP) ;
15 N I,DFN,APP,STDT,DT,APPINFO
16 S (DFN,APP)=0
17 S STDT=$$GETRESP($$NOW^XLFDT(),"Future Appointment search start date") I STDT="" S APP=-1 G OFAQ
18 W !,"Checking VistA future appointments ",STDT," forward..."
19 F I=1:1 S DFN=$O(^DPT(DFN)) Q:+DFN<1 D
20 .I I#10000=0 W "."
21 .S DT=STDT
22 .F S DT=$O(^DPT(DFN,"S",DT)) Q:+DT<1 D
23 ..S APPINFO=$G(^DPT(DFN,"S",DT,0))
24 ..I APPINFO="" W !,"Invalid Patient Appointment Node:",DFN,"-",DT Q
25 ..I $P(APPINFO,"^",2)="" D
26 ...S APP=APP+1
27 ...I CMP I $G(^TMP($J,"OFA",DFN))="" S EXC(DFN_"^"_DT)=^DPT(DFN,0)
28OFAQ Q APP
29POSTCHK ;
30 N PATH,FILENM,LN,TMP,I,DFN,BLCNT,EXC,VCNT
31 D HDR W !!,"Post-Backload Analysis - Outpatient future appointments."
32 S FILENM="SDCONV_ACCT.TXT",BLCNT=0,PATH=$$PWD^%ZISH()
33 S PATH=$$GETRESP(PATH,"Select Backload Path") Q:PATH=""
34 I '$$LISTF(PATH) S FILENM=""
35 S FILENM=$$GETRESP(FILENM,"Select Backload File") Q:FILENM=""
36 ;
37 K ^TMP($J,"OFA")
38 D OPEN^%ZISH("SD",PATH,FILENM,"R")
39 F U IO R LN:1 Q:LN']"" S ^TMP($J,"OFA",$P(LN,"^"))=LN,BLCNT=BLCNT+1
40 D CLOSE^%ZISH(IO)
41 ;
42 W !!,"File: ",FILENM," contains: ",BLCNT," records."
43 S VCNT=$$FUTRAPP(1)
44 W !!,VCNT," Outpatient future appointments identified in VistA..."
45 ;
46 W !," VistA Total:",$J(VCNT,10)
47 W !,"Backload Total:",$J(BLCNT,10)
48 W !,"=================================="
49 W !," ",$J(VCNT-BLCNT,10)
50 ;
51 I '$D(EXC) W !,"No Discrepencies between VistA and the Backload file" Q
52 W !!,"Missing patients from backload file:",!
53 S DFN=0
54 F I=1:1 S DFN=$O(EXC(DFN)) Q:DFN="" W !,I,") ",DFN,"^",EXC(DFN)
55 W !!,"Post analysis complete...."
56 K ^TMP($J,"OFA")
57 Q
58EP1 ;
59 N CNT,GOOD,ERR,SDKEY,ANS,PATH,Y,FN,GFILE,RFILE,FILENM
60 S SDKEY="SDCONV_ACCT.TXT",FILENM=SDKEY
61 S PATH=$$PWD^%ZISH(),(CNT,GOOD)=0
62 D HDR
63 S PATH=$$GETRESP(PATH,"Select Backload Path") Q:PATH=""
64 ;
65 I '$$LISTF(PATH) S FILENM=""
66 S FILENM=$$GETRESP(FILENM,"Select Backload File") Q:FILENM=""
67 S CNT=$$LOADFILE(PATH,FILENM)
68 ;
69 I CNT>0 S GOOD=$$PROCESS(CNT)
70 D RPTERR(CNT,GOOD,PATH_FILENM)
71 W !!,"Finished.... Mailman message sent to:",$$GET1^DIQ(200,DUZ,.01)," and G.PATCHES"
72 Q
73LISTF(PATH) ;
74 N GFILE,Y,RFILE,FN
75 S GFILE("SD*.TXT")=""
76 S Y=$$LIST^%ZISH(PATH,"GFILE","RFILE")
77 W !!,"SD*.TXT Files in ",PATH,!,"=================================="
78 I Y=1 S FN="" F S FN=$O(RFILE(FN)) Q:FN="" W !,?10,FN
79 I Y=0 W !!,?10,"** No files matching the SD*.TXT filter exists **"
80 Q Y
81HDR ;
82 D HOME^%ZIS W @IOF
83 W !!,"==========================================================="
84 W !,"Scheduled Outpatient Conversion Backload",!
85 W !," **********************************************************"
86 W !," * This Routine should ONLY be run by PFSS Implementation *"
87 W !," * Staff. DO NOT run this routine as part of the normal *"
88 W !," * Patch installation process. *"
89 W !," **********************************************************"
90 W !!,"==========================================================="
91 Q
92GETRESP(DEF,TXT) ;
93 N DIR,DIRUT,DTOUT,X,Y
94 S DIR(0)="Fr",DIR("A")=TXT,DIR("B")=DEF D ^DIR
95 I $D(DIRUT)!$D(DTOUT) S Y=""
96 Q Y
97RPTERR(CNT,GOOD,FULLPATH) ;
98 N REC,CAT,ROW,ERR,ET,DETAIL
99 N XMDF,XMDUZ,XMSUB,XMDUN,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMMG
100 S XMDF="",XMDUZ="SD53430P-"_$TR($P($$SITE^VASITE(),"^",2,3),"^","-")
101 S XMY(DUZ)="",XMY("G.PATCHES")=""
102 S XMSUB="PFSS Scheduled Outpatient Conversion"
103 D XMZ^XMA2 ; Call Create Message Module
104 I XMZ<1 D Q
105 .W !!,"** UNABLE TO CREATE MAILMAN MESSAGE PLEASE CHECK XTMP FOR DETAILS!"
106 ;
107 S ^XMB(3.9,XMZ,2,1,0)="Scheduled OutPatient Conversion Backload"
108 S ^XMB(3.9,XMZ,2,2,0)=" File: "_FULLPATH
109 S ^XMB(3.9,XMZ,2,3,0)=" Run By: "_$$GET1^DIQ(200,DUZ,.01)
110 S ^XMB(3.9,XMZ,2,4,0)=""
111 S ^XMB(3.9,XMZ,2,5,0)="Sucessful Records: "_GOOD
112 S ^XMB(3.9,XMZ,2,7,0)=" ----------------------"
113 S ^XMB(3.9,XMZ,2,8,0)=" Total Processed: "_CNT
114 S ^XMB(3.9,XMZ,2,9,0)="==============================================="
115 ;
116 S REC="",ROW=9,ERR=0
117 F S REC=$O(^XTMP(SDKEY,"ERR",REC)) Q:REC="" D
118 .S ERR=ERR+1,ROW=ROW+1
119 .S ^XMB(3.9,XMZ,2,ROW,0)="Record: "_REC_" ----------------------"
120 .S CAT=""
121 .F S CAT=$O(^XTMP(SDKEY,"ERR",REC,CAT)) Q:CAT="" D
122 ..S ROW=ROW+1,^XMB(3.9,XMZ,2,ROW,0)=" "_CAT
123 ..S ET=""
124 ..F S ET=$O(^XTMP(SDKEY,"ERR",REC,CAT,ET)) Q:ET="" D
125 ...S ROW=ROW+1
126 ...S ^XMB(3.9,XMZ,2,ROW,0)=" "_^XTMP(SDKEY,"ERR",REC,CAT,ET)
127 ;
128 S ^XMB(3.9,XMZ,2,6,0)=" Error Records: "_ERR
129 I ROW=9 S ROW=10,^XMB(3.9,XMZ,2,ROW,0)="Sucessful Backload..... No ERRORS found..."
130 ;
131 S ^XMB(3.9,XMZ,2,0)="^3.92^"_ROW_"^"_ROW_"^"_$$NOW^XLFDT()
132 D ENT1^XMD ;Deliver MSG
133 K ^XTMP(SDKEY)
134 Q
135LOADFILE(PATH,FILENM) ;
136 N POP,NOW,PURGDT,STOP,TOT,LN
137 W !,"Loading backload file..."
138 K ^XTMP(SDKEY)
139 S NOW=$$NOW^XLFDT(),PURGDT=NOW+2,TOT=0 ;Purge 2 days later
140 S ^XTMP(SDKEY,0)=PURGDT_"^"_NOW_"^PFSS Scheduled Outpatient Back Load"
141 ;
142 D OPEN^%ZISH("SD",PATH,FILENM,"R")
143 I $G(POP) S ^XTMP(SDKEY,"ERR",0,"FATAL",1)="Could NOT PROCESS File!"
144 ;
145 S (STOP,TOT)=0
146 F U IO R LN:1 Q:LN']"" Q:$$STATUS^%ZISH Q:STOP D
147 .I $G(LN)="" S STOP=1 Q
148 .S TOT=TOT+1,^XTMP(SDKEY,"DAT",TOT)=LN I TOT#1000=0 U 0 W "."
149 ;
150 D CLOSE^%ZISH(IO)
151LFQ Q TOT
152 ;
153PROCESS(TOT) ;
154 N CNT,INFO,DFN,SDT,SDCLN,SDEXVN,SDANR,SDCHK,GOOD
155 W !,"Processing data..."
156 S GOOD=0
157 F CNT=1:1:TOT D
158 .I CNT#1000=0 W "."
159 .S INFO=^XTMP(SDKEY,"DAT",CNT)
160 .S DFN=$P(INFO,"^",1),SDT=$P(INFO,"^",18)
161 .S SDCLN=$P(INFO,"^",8),SDEXVN=$TR($P(INFO,"^",21)," ","")
162 .;
163 .Q:$$CHKINFO(CNT,DFN,SDT,SDCLN,SDEXVN)
164 .S SDANR=$$GETARN^SDPFSS2(SDT,DFN,SDCLN)
165 .I +SDANR>0 D Q
166 ..I $$EXTNUM^IBBAPI(DFN,SDANR)'=SDEXVN D Q
167 ...S ^XTMP(SDKEY,"ERR",CNT,"ACCT",1)="Visit Number Discrepancy: "_INFO_" NOT EQUAL: "_SDANR
168 ..S GOOD=GOOD+1
169 .;
170 .S SDANR=$$IBBACONV^IBBAADTI(DFN,"O",SDT,SDCLN,SDEXVN)
171 .I SDANR="" S ^XTMP(SDKEY,"ERR",CNT,"ACCT",2)="PFSS Account Reference NOT Created" Q
172 .;
173 .S SDCHK=$$FILE^SDPFSS(DFN,SDT,SDCLN,SDANR)
174 .I +SDCHK<0 D
175 ..S ^XTMP(SDKEY,"ERR",CNT,"APPT LINK",1)="Unable to update file 409.55"
176 ..S ^XTMP(SDKEY,"ERR",CNT,"APPT LINK",2)=SDCHK
177 .I SDCHK="" S ^XTMP(SDKEY,"ERR",CNT,"APPT LINK",3)="Link Already Exists:"_INFO
178 .I +SDCHK=1 S GOOD=GOOD+1
179 Q GOOD
180CHKINFO(CNT,DFN,SDT,SDCLN,SDEXVN) ;
181 I SDEXVN="" S ^XTMP(SDKEY,"ERR",CNT,"IDX",1)="NO IDX Vist Number:"_INFO
182 ;
183 I +DFN=0 S ^XTMP(SDKEY,"ERR",CNT,"PATIENT",1)="DFN Invalid or Missing"
184 I +DFN>0 D
185 .I $G(^DPT(DFN,0))="" S ^XTMP(SDKEY,"ERR",CNT,"PATIENT",2)="Invalid Patient: "_DFN
186 ;
187 I +SDT=0 S ^XTMP(SDKEY,"ERR",CNT,"APPT DT/TIME",1)="Appointment Date/Time Invalid or Missing"
188 ;
189 I +SDCLN=0 S ^XTMP(SDKEY,"ERR",CNT,"LOCATION",1)="Location Invalid or Missing"
190 I +SDCLN>0 D
191 .I $G(^SC(SDCLN,0))="" S ^XTMP(SDKEY,"ERR",CNT,"LOCATION",2)="Invalid Location:"_SDCLN
192 Q $D(^XTMP(SDKEY,"ERR",CNT))
193 ;
Note: See TracBrowser for help on using the repository browser.