source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ0078.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: 7.4 KB
Line 
1PSJ0078 ;BIR/LDT-Check for Dispense Drug ;02 MAY 02 / 4:29 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**78**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^PSDRUG( is supported by DBIA# 2192.
6 ; Reference to ^OR(100 is supported by DBIA# 3582.
7 ; Reference to $$STATUS^ORQOR2 is supported by DBIA# 3458.
8 ;
9ENNV ; Begin check of existing orders
10 I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
11 K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0078",ZTDESC="Inpatient Orders Check (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
12 W !!,"The check of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
13 I $D(ZTSK) D
14 . W " (to start NOW).",!!,"YOU WILL RECEIVE 2 MAILMAN MESSAGES WHEN TASK #"_ZTSK_" HAS COMPLETED."
15 . W !,"IF ERRORS ARE DETECTED, YOU WILL RECEIVE ADDITIONAL MESSAGES INDICATING CLEANUP"
16 . W !,"HAS COMPLETED."
17 Q
18ENQN ; Check of existing Pharmacy orders.
19 N PSJBEG,PSJPDFN,PSJORD,PSJLORD,CREAT,EXPR,OCNT
20 D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0,PSJLORD=0
21 K ^XTMP("PSJ")
22 S PSJBEG="" F S PSJBEG=$O(^PS(55,"AUD",PSJBEG)) Q:PSJBEG="" S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,"AUD",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
23 . S PSJORD=0 F S PSJORD=$O(^PS(55,"AUD",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD Q:'+$G(^PS(55,PSJPDFN,5,PSJORD,.2)) D
24 .. S PSJDRG=0 F S PSJDRG=$O(^PS(55,PSJPDFN,5,PSJORD,1,PSJDRG)) Q:'PSJDRG I $P($G(^PS(55,PSJPDFN,5,PSJORD,1,PSJDRG,0)),"^")="" S ^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG)=$P($G(^PS(55,PSJPDFN,5,PSJORD,.2)),"^") S:PSJORD'=PSJLORD OCNT=OCNT+1 D
25 ... S PSJLORD=PSJORD I PSJDRG>1 S $P(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),"^",2)="MULTIPLE DISPENSE DRUGS",$P(^XTMP("PSJ",PSJPDFN,PSJORD,1),"^",2)="MULTIPLE DISPENSE DRUGS"
26 ... D SET
27 S:$D(^XTMP("PSJ")) ^XTMP("PSJ",0)=EXPR_"^"_CREAT
28 D SENDMSG
29 I $D(^XTMP("PSJ")) D CLEAN
30DONE ;
31 K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
32 K ^XTMP("PSJ")
33 D ENQN^PSJ078A
34 K ^XTMP("PSJ"),^XTMP("PSJ XREF")
35 Q
36SENDMSG ;Send mail message when check is complete.
37 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*78 INPATIENT MEDS DISPENSE DRUG ORDER CHECK COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
38 S PSG(1,0)="The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
39 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)
40 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)_"."
41 S PSG(6,0)=OCNT_" pharmacy orders were found with no Dispense Drug."
42 D ^XMD
43 Q
44 ;
45CLEAN ;
46 N PSJPDFN,PSJORD,PSJDRG,PSJOI,DRG,CCNT,LFCNT,PSSTART,PSSTOP,PSSTATUS,ORSTART,ORSTOP,ORSTATUS,CHK,CHK3 S CCNT=0,LFCNT=0
47 S PSJPDFN=0 F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN S PSJORD=0 F S PSJORD=$O(^XTMP("PSJ",PSJPDFN,PSJORD)) Q:'PSJORD S PSJDRG=0 F S PSJDRG=$O(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG)) Q:'PSJDRG D
48 . I '$D(^PS(55,PSJPDFN,5,PSJORD)) Q
49 . I $P(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),U,2)="" S PSJOI=$P(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),U) S:PSJOI]"" DRG=$$CHECK I DRG D
50 .. S $P(^PS(55,PSJPDFN,5,PSJORD,1,1,0),U)=DRG,^PS(55,PSJPDFN,5,+PSJORD,1,"B",DRG,1)="" K ^PS(55,PSJPDFN,5,PSJORD,1,"B",0,1) S CCNT=CCNT+1
51 .. K DR D NOW^%DTC S PSSTART=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^"),PSSTOP=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^",2),PSSTATUS=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^",3)
52 .. S ORSTART=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^"),ORSTOP=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^",2),ORSTATUS=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^",3),DIE="^PS(55,"_PSJPDFN_",5,",DA=PSJORD,DA(1)=PSJPDFN
53 .. D CHECK2 I CHK,ORSTOP'="",+ORSTOP<+PSSTOP,+ORSTOP<% S STPDT=ORSTOP,DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////^S X=STPDT"
54 .. I CHK,ORSTOP'="",+ORSTOP<+PSSTOP,+ORSTOP'<% S STPDT=%,DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////^S X=STPDT"
55 .. I CHK,ORSTOP'="",PSSTOP="" S DR="10////^S X=PSSTART;28////D"_$S(ORSTOP<%:";34////^S X=ORSTOP",1:";34////"_%)
56 .. I CHK,ORSTOP="",PSSTOP'="",+PSSTOP'>% S DR="10////^S X=PSSTART;28////D;34////^S X=PSSTOP"
57 .. I CHK,ORSTOP="",PSSTOP="" S DR="10////^S X=PSSTART;28////D;34////"_%
58 .. I CHK,ORSTOP="",+PSSTOP>% S DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////"_%
59 .. I CHK,+ORSTOP=+PSSTOP,+PSSTOP<% S DR="10////^S X=PSSTART;28////D;34////^S X=PSSTOP"
60 .. I CHK,+ORSTOP=+PSSTOP,+PSSTOP'<% S DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////"_%
61 .. I 'CHK S:((PSSTATUS="A")&(+PSSTOP<%)) DR="10////^S X=PSSTART;28////E;34////^S X=PSSTOP" I PSSTATUS="A",+PSSTOP'<% I $$CHECKDUP^PSGOERI(PSJPDFN,PSJORD) S DR="10////^S X=PSSTART;28////D;34////"_%
62 .. I 'CHK,PSSTATUS="A",+PSSTOP'<% I '$$CHECKDUP^PSGOERI(PSJPDFN,PSJORD) S DR="10////^S X=PSSTART;34////^S X=PSSTOP"
63 .. I 'CHK,PSSTATUS'="A" S DR="10////^S X=PSSTART;34////^S X=PSSTOP"
64 .. I $D(DR) D ^DIE
65 .. S PSJHLMTN="ORM" D EN1^PSJHL2(PSJPDFN,"SC",PSJORD_"U") K ^XTMP("PSJ",PSJPDFN,PSJORD)
66 S PSJPDFN=0 F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN S LFCNT=LFCNT+1
67 I 'LFCNT K ^XTMP("PSJ")
68 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*78 INPATIENT MEDS DISPENSE DRUG ORDER CLEANUP COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
69 S PSG(1,0)="The cleanup of Inpatient Medication orders with no Dispense Drugs ",PSG(2,0)="completed as of "_Y_"."
70 S PSG(3,0)=""
71 S PSG(4,0)=CCNT_" pharmacy orders with no Dispense Drugs were corrected."
72 I $D(^XTMP("PSJ")) S PSG(5,0)="",PSG(6,0)="The following orders couldn't be corrected:",MSGCNT=7 D
73 . S PSG(7,0)="Patient's DFN Order #"
74 . S PSJPDFN=0 F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN S PSJORD=0 F S PSJORD=$O(^XTMP("PSJ",PSJPDFN,PSJORD)) Q:'PSJORD D
75 .. S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)=$J(PSJPDFN,13)_" "_$J(PSJORD,6)_"U"
76 .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)=""
77 .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)="The person who installs this patch and the pharmacy adpac should work together"
78 .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)="to identify what the missing Dispense Drug should be and get the order updated."
79 .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)="Should you require further assistance please contact NVS."
80 D ^XMD
81 Q
82 ;
83CHECK() ;
84 I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
85 N Q,X,DRG,QPT S (X,Q,QPT)=0
86 F DRG=0:0 S DRG=$O(^PSDRUG("ASP",PSJOI,DRG)) Q:'DRG S:$G(^PSDRUG(DRG,"I")) X=^("I")'>PSGDT I $P(^PSDRUG(DRG,2),U,3)["U" S Q=Q+1 S:'X QPT=DRG
87 Q $S(Q=1:QPT,1:0)
88SET ;
89 S F="^PS(55,"_PSJPDFN_",5,"_PSJORD_","
90 S ND=$G(@(F_"0)")),OERR=+$P(ND,"^",21),ND2=$G(@(F_"2)")),PSSTART=$P(ND2,"^",2),PSSTOP=$P(ND2,"^",4),PSSTATUS=$P(ND,"^",9)
91 S ORND=$G(^OR(100,OERR,0)),ORND3=$G(^OR(100,OERR,3)),PSPTR=$G(^OR(100,OERR,4)),ORSTART=$P(ORND,"^",8),ORSTOP=$P(ORND,"^",9),ORSTATUS=$P(ORND3,"^",3) Q:'ND D
92 .S:'OERR ^XTMP("PSJ",PSJPDFN,PSJORD,3)=OERR_U_PSPTR
93 .S:+PSPTR'=PSJORD ^XTMP("PSJ",PSJPDFN,PSJORD,4)=OERR_U_PSPTR_U_$P(ND,"^")
94 .S ^XTMP("PSJ",PSJPDFN,PSJORD,5)=PSSTART_U_PSSTOP_U_PSSTATUS,^XTMP("PSJ",PSJPDFN,PSJORD,6)=ORSTART_U_ORSTOP_U_$$STATUS^ORQOR2(OERR)_U_OERR
95 Q
96CHECK2 ;
97 S CHK=0
98 I +PSSTART'=+ORSTART S CHK=1 Q
99 I +PSSTOP'=+ORSTOP S CHK=1 Q
100 D @PSSTATUS
101 Q
102A S:ORSTATUS'=6 CHK=1 Q
103D S:"1^13"'[ORSTATUS CHK=1 Q
104DE S:"1^12^13"'[ORSTATUS CHK=1 Q
105DR S:"1^13^15"'[ORSTATUS CHK=1 Q
106E S:ORSTATUS'=7 CHK=1 Q
107H S:ORSTATUS'=3 CHK=1 Q
108I S:ORSTATUS'=9 CHK=1 Q
109N S:ORSTATUS'=5 CHK=1 Q
110O S:ORSTATUS'=3 CHK=1 Q
111P S:ORSTATUS'=5 CHK=1 Q
112R S:ORSTATUS'=15 CHK=1 Q
113RE S:ORSTATUS'=6 CHK=1 Q
114U S CHK=1 Q
Note: See TracBrowser for help on using the repository browser.