source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ0071.m@ 1258

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

initial load of WorldVistAEHR
File size: 5.6 KB
RevLine 
[613]1PSJ0071 ;BIR/JLC - Check for mis-matched schedule internal ; 19-FEB-02
2 ;;5.0; INPATIENT MEDICATIONS ;**71**;16 DEC 97
3 ;
4 ; Reference to ^DD is supported by DBIA# 10017.
5 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
6 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
7 ; Reference to ^VA(200 is supported by DBIA# 10060.
8 ; Reference to ^VADPT is supported by DBIA# 10061.
9 ; Reference to ^XPD is supported by DBIA# 2197.
10 ; Reference to ^PS(55 is supported by DBIA# 2191.
11 ; Reference to ^%DTC is supported by DBIA# 10000.
12 ; Reference to ^%ZTLOAD is supported by DBIA# 10063.
13 ; Reference to ^XLFDT is supported by DBIA# 10103.
14 ; Reference to ^XMD is supported by DBIA# 10070.
15 ;
16ENNV ; Begin check of existing orders
17 I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
18 K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0071",ZTDESC="Inpatient Orders Check (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
19 W !!,"The check of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
20 I $D(ZTSK) D
21 . W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED. IF"
22 . W !,"ERRORS ARE DETECTED, YOU WILL RECEIVE A SECOND MESSAGE INDICATING CLEANUP"
23 . W !,"HAS COMPLETED."
24 Q
25ENQN ; Check of existing Pharmacy orders.
26 N PSJSTART,CREAT,EXPR,OCNT,IEN,PSJBEG,PSJPDFN,PSJORD,PSJND0,PSJSCH,PSJADM,PSJFRE,PSJSTA,A,PSGST,PSGS0XT,X,DAYS,MINS
27 S PSGOES=1,OCNT=0
28 D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0)
29 K ^XTMP("PSJ71")
30 ;process the IV start date crossreference to find orders
31 ;begin with the first date that PSJ*5*50 was installed
32 S IEN=$O(^XPD(9.7,"B","PSJ*5.0*50","")),PSJBEG=$P(^XPD(9.7,IEN,1),"^",3)-1
33 F S PSJBEG=$O(^PS(55,"AIVS",PSJBEG)) Q:'PSJBEG D
34 . S PSJPDFN=0
35 . F S PSJPDFN=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
36 .. S PSJORD=0
37 .. F S PSJORD=$O(^PS(55,"AIVS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
38 ... S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSCH=$P(PSJND0,"^",9),PSJADM=$P(PSJND0,"^",11),PSJFRE=$P(PSJND0,"^",15),PSJSTA=$P(PSJND0,"^",17)
39 ... Q:PSJSTA="D" Q:PSJSCH="" Q:PSJFRE="" Q:PSJFRE="O" K PSGS0XT
40 ... I $D(^PS(51.1,"APPSJ",PSJSCH)) D S A=^PS(51.1,X,0),PSGST=$P(A,"^",5),PSGS0XT=$P(A,"^",3) Q:PSGST="O" Q:PSGS0XT=PSJFRE G ERR
41 .... S X=0 F S X=$O(^PS(51.1,"APPSJ",PSJSCH,X)) Q:'X I $P(^PS(51.1,X,0),"^",2)=PSJADM Q
42 .... I 'X S X=$O(^PS(51.1,"APPSJ",PSJSCH,0))
43 ... I PSJSCH="ONCE"!(PSJSCH="NOW")!(PSJSCH="ONE TIME")!(PSJSCH="ONETIME")!(PSJSCH="ONE-TIME")!(PSJSCH="1TIME")!(PSJSCH="1 TIME")!(PSJSCH="1-TIME")!(PSJSCH="STAT") Q
44 ... Q:PSJSCH["PRN"
45 ... S X=PSJSCH D EN^PSGS0 I $G(PSGS0XT)="" S PSGS0XT=1440
46 ... I $G(PSGS0XT)=PSJFRE Q
47ERR ... S ^XTMP("PSJ71",PSJPDFN,PSJORD)=PSJSCH_"^"_PSJFRE_"^"_$G(PSGS0XT),OCNT=OCNT+1
48 S:$D(^XTMP("PSJ71")) ^XTMP("PSJ71",0)=EXPR_"^"_CREAT
49 D SENDMSG
50 I $D(^XTMP("PSJ71")) D CLEAN
51DONE ;
52 K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
53 Q
54SENDMSG ;Send mail message when check is complete.
55 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER CHECK COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
56 S PSG(1,0)=" The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
57 S X=$$FMDIFF^XLFDT(%,PSJSTART,3) S:$L(X," ")>1 DAYS=+$P(X," "),X=$P(X," ",2) S HOURS=+$P(X,":"),MINS=+$P(X,":",2)
58 S PSG(3,0)=" ",PSG(4,0)="This process checked orders for patients in "_$S($G(DAYS):DAYS_" day"_$E("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$E("s",HOURS'=1),PSG(5,0)="and "_MINS_" minute"_$E("s",MINS'=1)_"."
59 S PSG(6,0)=OCNT_" pharmacy orders were found with potential frequency mis-matches."
60 D ^XMD
61 Q
62 ;
63CLEAN ;
64 S INS=$P(^VA(200,DUZ,0),"^"),PSJPDFN=0,BEG=1,END=0,PCNT=2,$P(BLANK," ",40)=""
65 F S PSJPDFN=$O(^XTMP("PSJ71",PSJPDFN)) Q:'PSJPDFN S PSJORD=0 D
66 . S DFN=PSJPDFN K VADM D DEM^VADPT
67 . F S PSJORD=$O(^XTMP("PSJ71",PSJPDFN,PSJORD)) Q:'PSJORD D
68 .. I '$D(^PS(55,PSJPDFN,"IV",PSJORD)) Q
69 .. S A=^XTMP("PSJ71",PSJPDFN,PSJORD),PSJFRE=$P(A,"^",2),PSGS0XT=$P(A,"^",3)
70 .. S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",15)=PSGS0XT
71 .. D LOG
72 .. S PCNT=PCNT+1,PSG(PCNT,0)=$E(VADM(1),1,25)_$E(BLANK,1,27-$L(VADM(1)))_$P(VADM(2),"^")
73 .. S AD=$O(^PS(55,PSJPDFN,"IV",PSJORD,"AD",0)) I AD]"" S AIEN=$P($G(^(AD,0)),"^"),OINAME=$P(^PS(52.6,AIEN,0),"^")
74 .. S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSTRT=$P(PSJND,"^",2),PSJSTP=$P(PSJND,"^",3)
75 .. S Y=PSJSTRT X ^DD("DD") S FSTRT=Y
76 .. S Y=PSJSTP X ^DD("DD") S FSTOP=Y
77 .. S OINAME=$G(OINAME)
78 .. S PCNT=PCNT+1,PSG(PCNT,0)=" "_$E(OINAME,1,25)_$E(BLANK,1,28-$L(OINAME))_"Start: "_FSTRT_" Stop: "_FSTOP
79 .. S PCNT=PCNT+1,PSG(PCNT,0)=" "
80 .. S END=END+1 I '(END#500) D CLEANMSG(BEG,END) K PSG S PCNT=2,BEG=END+1
81 D CLEANMSG(BEG,END) Q
82CLEANMSG(BEG,END) K XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER ("_BEG_"-"_END_") CLEANUP COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
83 S PSG(1,0)=" The cleanup of Inpatient Medication orders with schedule interval problems ",PSG(2,0)="completed as of "_Y_"."
84 D ^XMD
85 Q
86LOG ; Create field change entry in activity log.
87 N %,X,Y S:'$D(^PS(55,PSJPDFN,"IV",PSJORD,"A",0)) ^(0)="^55.04A^^" S PSIVLN=($P(^PS(55,PSJPDFN,"IV",PSJORD,"A",0),"^",3)+1),$P(^(0),"^",3)=PSIVLN,$P(^(0),"^",4)=$P(^(0),"^",4)+1
88 D NOW^%DTC S ^PS(55,PSJPDFN,"IV",PSJORD,"A",PSIVLN,0)=PSIVLN_"^E^"_INS_"^PSJ*5*71 SCHEDULE FREQUENCY MISMATCH^"_%
89 S ND=$G(^PS(55,PSJPDFN,"IV",PSJORD,"A",PSIVLN,1,0)) S:ND="" ND="^55.151^^"
90 S $P(ND,U,3)=$P(ND,U,3)+1,$P(ND,U,4)=$P(ND,U,4)+1,^PS(55,PSJPDFN,"IV",PSJORD,"A",PSIVLN,1,0)=ND,^PS(55,PSJPDFN,"IV",PSJORD,"A",PSIVLN,1,$P(ND,U,3),0)="SCHEDULE INTERVAL^"_PSJFRE_"^"_PSGS0XT K ND
91 Q
Note: See TracBrowser for help on using the repository browser.