1 | PSO55FX3 ;ISC-BHAM/MHA - cleanup of bad p nodes and mismatched Rxs in file 55 ; 07/26/2001
|
---|
2 | ;;7.0;OUTPATIENT PHARMACY;**69**;DEC 1997
|
---|
3 | ;External reference to ^PS(55 is supported by DBIA 2228
|
---|
4 | MSG ;
|
---|
5 | W @IOF,"*** This patch will be queued to run in the background ***",!
|
---|
6 | W !,"It will scan through the PHARMACY PATIENT file (#55) and will look"
|
---|
7 | W !,"for possible bad 'P' or 'P','A' cross-references or prescriptions with"
|
---|
8 | W !,"mismatched patients. If it finds any bad cross-references then it will clean"
|
---|
9 | W !,"those bad cross-references and a count of them for each Outpatient Site"
|
---|
10 | W !,"entry will be sent in a mail message to the patch installer. If it finds any"
|
---|
11 | W !,"prescriptions that belong to other patients the mail message will also include"
|
---|
12 | W !,"a list of those patients with prescriptions that may have been discontinued"
|
---|
13 | W !,"because a DATE OF DEATH or an ADMISSION was entered for the patient with a"
|
---|
14 | W !,"corrupt cross-reference. Forward this mail message to the corresponding"
|
---|
15 | W !,"Pharmacy Application Coordinator, or to the appropriate Outpatient Pharmacy"
|
---|
16 | W !,"Personnel, for their review and correction. It will send summary information"
|
---|
17 | W !,"to G.PL2 PATCH TRACKING group on FORUM to keep a count of bad nodes by site."
|
---|
18 | W !,"This patch will also scan through the PRESCRIPTION file (#52) using the 'AD'"
|
---|
19 | W !,"cross-reference and will check if a corresponding entry exists in the"
|
---|
20 | W !,"PHARMACY PATIENT file (#55). The software will provide a count of missing"
|
---|
21 | W !,"entries in a separate mail message that will be sent to G.PL2 PATCH TRACKING"
|
---|
22 | W !,"on FORUM for their review.",!
|
---|
23 | S DIR(0)="E",DIR("A")="Press Return to Continue " D ^DIR K DIR W !
|
---|
24 | W !,"This task stores information in ^XTMP(""PSO"" global. Upon completion of the"
|
---|
25 | W !,"cleanup process, the information stored in this global will be used to"
|
---|
26 | W !,"generate several e-mail messages. If this task stops unexpectedly, it can be"
|
---|
27 | W !,"restarted by doing BEG^PSO55FX2. The routine will begin processing with the"
|
---|
28 | W !,"last record reviewed and will utilize the same global reference for storing"
|
---|
29 | W !,"data. No information will be lost.",!
|
---|
30 | W !,"We recommend re-indexing the ""B"" cross-reference of the PHARMACY PATIENT file"
|
---|
31 | W !,"(#55), during non-peak hours or when the number of pharmacy users on the system"
|
---|
32 | W !,"is at a minimum any time after completion of this job.",!!
|
---|
33 | Q
|
---|
34 | PH2 ;
|
---|
35 | S SD=2980101,PS=0,RX=0,TY="PSO",JN="692"
|
---|
36 | I '$D(^XTMP(TY,JN)) S X1=DT,X2=+90 D C^%DTC S ^XTMP(TY,JN,0)=$G(X)_"^"_DT G SPH2
|
---|
37 | I $D(^XTMP(TY,JN,1)) D
|
---|
38 | .S SD=$P($G(^XTMP(TY,JN,1)),"^") S:'SD SD=2980101
|
---|
39 | .S RX=$P($G(^XTMP(TY,JN,1)),"^",2) S:'RX RX=0
|
---|
40 | .S PS=$P($G(^XTMP(TY,JN,1)),"^",3) S:'PS PS=0
|
---|
41 | SPH2 F S SD=$O(^PSRX("AD",SD)) Q:'SD!(SD>3010801) D
|
---|
42 | .F S RX=$O(^PSRX("AD",SD,RX)) Q:'RX I $O(^PSRX("AD",SD,RX,""))=0,$D(^PSRX(RX,"STA")),+^PSRX(RX,"STA")'=13 D
|
---|
43 | ..Q:$D(^PSRX(RX,"D"))
|
---|
44 | ..S DFN=$P($G(^PSRX(RX,0)),"^",2),(PF,J)=0
|
---|
45 | ..I DFN F S J=$O(^PS(55,DFN,"P",J)) Q:PF!('J) D
|
---|
46 | ...I $P($G(^PS(55,DFN,"P",J,0)),"^")=RX S PF=1 Q
|
---|
47 | ..I 'PF S PS=PS+1,^XTMP(TY,JN,2,PS)=$E(RX_" ",1,12)_$G(^PSRX(RX,0))
|
---|
48 | ..S ^XTMP(TY,JN,1)=(SD-.1)_"^"_RX_"^"_PS
|
---|
49 | .S RX=0
|
---|
50 | S ZZ="PSO",^TMP(ZZ,$J,1)=""
|
---|
51 | S ^TMP(ZZ,$J,2)="Total Count of PRESCRIPTION Entries Missing from PHARMACY PATIENT file: "_PS
|
---|
52 | S ^TMP(ZZ,$J,3)=""
|
---|
53 | I PS D
|
---|
54 | .S ^TMP(ZZ,$J,4)="Prescription Information"
|
---|
55 | .S ^TMP(ZZ,$J,5)="IEN ZERO NODE"
|
---|
56 | .S ^TMP(ZZ,$J,6)="----------- -------------------------------------------------------------------"
|
---|
57 | .S XX=7,J=0
|
---|
58 | .F S J=$O(^XTMP(TY,JN,2,J)) Q:'J S ^TMP(ZZ,$J,XX)=^XTMP(TY,JN,2,J),XX=XX+1
|
---|
59 | S XMY("G.PL2 PATCH TRACKING@FORUM.VA.GOV")=""
|
---|
60 | ;S XMY(DUZ)=""
|
---|
61 | S XMSUB=$P($$SITE^VASITE(),"^",2)_" - PSO*7*69 - PART TWO"
|
---|
62 | S XMDUZ="Missing Rx entries from PHARMACY PATIENT file (#55)"
|
---|
63 | S XMTEXT="^TMP(ZZ,$J," D ^XMD
|
---|
64 | K ^XTMP(TY,JN),^TMP(ZZ,$J),^XTMP("PSO2",69),XMY,XMDUZ,SD,JN,TY,DFN,RX,XX,ZZ,J,PF,PS,X1,X2
|
---|
65 | K AL,CDT,CT,EDT,II,JJ,PDFN,QQ,S1,S2,SDT,YY,UL
|
---|
66 | S:$D(ZTQUEUED) ZTREQ="@"
|
---|
67 | Q
|
---|