close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOELPS2.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOELPS2.m@ 1769

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
1PSOELPS2 ;BIR/EJW-CPRS and Outpatient Pharmacy Status Update ;12/04/02
2 ;;7.0;OUTPATIENT PHARMACY;**119,268**;DEC 1997;Build 9
3 ;External reference to STATUS^ORQOR2 supported by DBIA 3458
4 ;External reference to ^OR(100 supported by DBIA 3463
5 ;CPRS/Outpatient status update
6 ;PSOCPRS = CPRS number (Placer)
7 ;PSORXNUM = Outpatient number (52 ien)
8 N PSOPACRF
9 D GETPACRF
10 I '$D(PSOPACRF) Q
11 D BMES^XPDUTL("This post-install job searches for Outpatient Pharmacy orders")
12 D MES^XPDUTL("that are deleted but are Active in CPRS. If any are found")
13 D MES^XPDUTL("the order in CPRS will be updated with the appropriate status.")
14 D BMES^XPDUTL("The job also looks for Outpatient Pharmacy orders that are marked")
15 D MES^XPDUTL("as DC'd by provider and if they really were deleted instead")
16 D MES^XPDUTL("of discontinued, the CPRS order will be updated with the")
17 D MES^XPDUTL("correct Stop Date.")
18 D BMES^XPDUTL("This post-install also attempts to clean up a bad node in the")
19 D MES^XPDUTL("PRESCRIPTION file (#52) caused if an up-arrow (^) was entered for")
20 D MES^XPDUTL("the LOT# when editing a prescription.")
21 D GETDATE
22 S ZTRTN="EN^PSOELPS2",ZTDESC="Pharmacy/CPRS status clean up",ZTIO="",ZTSAVE("PSOPACRF")="" D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
23 W:$D(ZTSK)&('$D(ZTQUEUED)) !!,"Task Queued !",!
24 Q
25EN ;
26 L +^XTMP("PSOELPS2"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
27 N PSOCPRS,PSORXNUM,PSOXCOM,PSOXDT,PSOIJ,PSOJJ,PSOREAS,PSOACRL,PSOPHR,PSOALC,PSOADT,PSONAT,PSOCOMM,PSOZDUZ,PSOSTART,PSOEND,PSOETEXT,PSOECT,PSOCSTAT,PSOSTA
28 I '$D(PSOPACRF) D GETPACRF I '$D(PSOPACRF) Q
29 I '$G(DT) S DT=$$DT^XLFDT
30 D NOW^%DTC S PSOSTART=%
31 S PSOECT=0,PSORX2=0
32 S PSOCPRS="" F S PSOCPRS=$O(^PSRX("APL",PSOCPRS)) Q:PSOCPRS="" S PSORXNUM="" F S PSORXNUM=$O(^PSRX("APL",PSOCPRS,PSORXNUM)) Q:PSORXNUM="" D
33 .I PSOCPRS'=$P($G(^PSRX(PSORXNUM,"OR1")),"^",2) Q
34 .I '$D(^PSRX(PSORXNUM,0)) Q
35 .D CHKARROW ; SEE IF AN EXTRA UP-ARROW IN ^PSRX(PSORXNUM,2) NODE
36 .S PSOSTA=+$$STATUS^ORQOR2(PSOCPRS) I PSOSTA'=6,PSOSTA'=1 Q
37 .I PSORXNUM'=$P($G(^OR(100,PSOCPRS,4)),"^") Q
38 .I PSOPACRF'=$P($G(^OR(100,PSOCPRS,0)),"^",14) Q
39 .S PSOCSTAT=$P($G(^PSRX(PSORXNUM,"STA")),"^")
40 .I PSOSTA=6,PSOCSTAT=13 D ; MARKED AS ACTIVE IN CPRS, DELETED IN O/P PHARMACY
41 ..D GETDEL
42 ..I 'PSOJJ Q
43 ..D UPDCPRS
44 .I PSOSTA=1,PSOCSTAT=14 D ; MARKED AS 'DISCONTINUED BY PROVIDER' IN CPRS - CHECK FOR PREVIOUSLY DELETED IN O/P PHARMACY
45 ..D GETDEL
46 ..I 'PSOJJ Q
47 ..D ACT
48 ..D UPDCPRS
49 ..S $P(^PSRX(PSORXNUM,"STA"),"^",1)=13
50MAIL ;Send MailMan message upon job completion
51 K PSOPACRF
52 I $G(DUZ) D
53 .S XMDUZ="Patch PSO*7*119 Post-Install",XMSUB="Outpatient/CPRS Status clean-up",XMY(DUZ)=""
54 .D NOW^%DTC S PSOEND=%
55 .S PSOETEXT(1)="The clean-up job for patch PSO*7*119 is complete."
56 .S PSOETEXT(2)="The total number of mismatched statuses found were "_+$G(PSOECT)_"."
57 .S PSOETEXT(3)="The total number of missing divisions were "_PSORX2_"."
58 .S Y=$G(PSOSTART) D DD^%DT S PSOSTART=$G(Y)
59 .S Y=$G(PSOEND) D DD^%DT S PSOEND=$G(Y)
60 .S PSOETEXT(4)="The job started on "_$G(PSOSTART)_"."
61 .S PSOETEXT(5)="The job ended on "_$G(PSOEND)_"."
62 .S XMTEXT="PSOETEXT(" N DIFROM D ^XMD K Y,XMDUZ,XMTEXT,XMSUB
63 L -^XTMP("PSOELPS2")
64 S:$D(ZTQUEUED) ZTREQ="@"
65 Q
66 ;
67GETDEL ;
68 S PSOCOMM=""
69 S (PSOIJ,PSOJJ,PSOPHR,PSOADT)=0 F S PSOIJ=$O(^PSRX(PSORXNUM,"A",PSOIJ)) Q:'PSOIJ S PSOREAS=$P($G(^(PSOIJ,0)),"^",2) I PSOREAS="D" I $P($G(^PSRX(PSORXNUM,"A",PSOIJ,0)),"^",4)=0 S PSOJJ=PSOIJ
70 I 'PSOJJ Q
71 S PSOACRL=$G(^PSRX(PSORXNUM,"A",PSOJJ,0)) D
72 .S PSOPHR=$P(PSOACRL,"^",3),PSOALC=$P(PSOACRL,"^",5),PSOADT=$P(PSOACRL,"^"),(PSONAT,PSOCOMM)=""
73 .I PSOALC["DELETED" S PSOCOMM=PSOALC
74 Q
75 ;
76UPDCPRS ; UPDATE CPRS ENTRY WITH CORRECT STATUS AND DATE
77 S PSOZDUZ=$G(DUZ) S:$G(PSOPHR) DUZ=PSOPHR D EN^PSOHLSN1(PSORXNUM,"OC","",PSOCOMM,PSONAT) S PSOECT=PSOECT+1 S DUZ=PSOZDUZ
78 I '$G(PSOADT) S PSOADT=DT_".2200"
79 I '$D(^XTMP("PSOELPS2")) S X1=DT,X2=+30 D C^%DTC S ^XTMP("PSOELPS2",0)=$G(X)_"^"_DT
80 I $D(^OR(100,PSOCPRS,6)) S ^XTMP("PSOELPS2",$J,PSOCPRS,6)=^(6),$P(^OR(100,PSOCPRS,6),"^",3)=$E(PSOADT,1,12)
81 I $D(^OR(100,PSOCPRS,3)) S ^XTMP("PSOELPS2",$J,PSOCPRS,3)=^(3),$P(^OR(100,PSOCPRS,3),"^")=$E(PSOADT,1,12)
82 Q
83 ;
84ACT ; SET ENTRY IN ACTIVITY LOG
85 N IR,J
86 S IR=0 F J=0:0 S J=$O(^PSRX(PSORXNUM,"A",J)) Q:'J S IR=J
87 S IR=IR+1,^PSRX(PSORXNUM,"A",0)="^52.3DA^"_IR_"^"_IR
88 D NOW^%DTC S ^PSRX(PSORXNUM,"A",IR,0)=%_"^"_"E^"_$G(DUZ)_"^0^Dc'd by mistake, resetting back to deleted"
89 Q
90 ;
91CHKARROW ;
92 N RX2
93 S RX2=$G(^PSRX(PSORXNUM,2)) I RX2="" Q
94 I $P(RX2,"^",9)="" D
95 .I $P(RX2,"^",5)'?7N,$P(RX2,"^",6)?7N,$P(RX2,"^",7)?7N D
96 ..S ^XTMP("PSOELPS2",$J,"RX2",PSORXNUM)=RX2
97 ..S RX2=$P(RX2,"^",1,3)_"^"_$P(RX2,"^",5,99)
98 ..S PSORX2=PSORX2+1
99 ..S ^PSRX(PSORXNUM,2)=RX2
100 Q
101 ;
102GETPACRF ;
103 S DIC=9.4,DIC(0)="Z",X="OUTPATIENT PHARMACY" D ^DIC K DIC
104 I +Y'>0 D Q
105 .D BMES^XPDUTL("A problem was found when trying to identify a valid Outpatient Pharmacy")
106 .D BMES^XPDUTL("package reference from the PACKAGE (#9.4) file.")
107 .D BMES^XPDUTL("This post-install job cannot be run until this problem is resolved.")
108 .K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
109 S PSOPACRF=+Y
110 Q
111 ;
112GETDATE ; GET DATE/TIME OF WHEN BACKGROUND JOB SHOULD BE RUN
113 S ZTDTH=""
114 S NOW=0
115 D NOW^%DTC S (Y,TODAY)=% D DD^%DT
116 D BMES^XPDUTL("At the following prompt, enter a starting date@time or enter NOW to")
117 D MES^XPDUTL("queue the job immediately.")
118 D MES^XPDUTL("If this prompting is during patch installation, you will not see what you type.")
119 W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue clean-up Job to run Date@Time: "
120 D ^%DT K %DT I $D(DTOUT)!(Y<0) D MES^XPDUTL("Task will be queued to run NOW") S ZTDTH=$H,NOW=1
121 I 'NOW,Y>0 D
122 .S SAVEY=Y
123 .D DD^%DT
124 .S X=Y
125 .S Y=SAVEY
126ASK D BMES^XPDUTL("Task will be queued to run "_$S(NOW:"NOW",1:X)_". Is that correct? :")
127 R XX:300 S:'$T XX="Y" I $E(XX)'="Y",$E(XX)'="y",$E(XX)'="N",$E(XX)'="n" D BMES^XPDUTL(" Enter Y or N") G ASK
128 I $E(XX)'="Y",$E(XX)'="y" G GETDATE
129 I Y>0,ZTDTH="" S ZTDTH=Y
130 I ZTDTH="" S ZTDTH=$H
131 Q
Note: See TracBrowser for help on using the repository browser.