source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ0091.m@ 901

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1PSJ0091 ;BIR/LDT-Check for Frequency ;19 DEC 02 / 12:29 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**91**;16 DEC 97
3 ;
4 ; Reference to ^XPD is supported by DBIA# 2197.
5 ; Reference to ^XLFDT is supported by DBIA# 10103.
6 ; Reference to ^PS(55 is supported by DBIA# 2191.
7 ;
8ENNV ; Begin check of existing orders
9 I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
10 K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0091",ZTDESC="Inpatient Orders Frequency Cleanup (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
11 W !!,"The cleanup of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
12 I $D(ZTSK) D
13 . W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
14 Q
15ENQN ; Check of existing Pharmacy orders.
16 N PSJBEG,PSJPDFN,PSJORD,PSJLORD,CREAT,EXPR,CCNT,ND0,ND2,PSJSTART,PSJSTOP,PSJPRIO,PSJFREQ,NDPT2,PSJSCH
17 D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0,PSJLORD=0,CCNT=0
18 K ^XTMP("PSJ","FREQ")
19 N XPDIEN58 S XPDIEN58=$O(^XPD(9.7,"B","PSJ*5.0*58",""))
20 S PSJBEG=$S($G(XPDIEN58):$P($G(^XPD(9.7,XPDIEN58,0)),"^",3),1:0)
21 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
22 . S PSJORD=0 F S PSJORD=$O(^PS(55,"AUD",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
23 .. S ND0=$G(^PS(55,PSJPDFN,5,PSJORD,0)),NDPT2=$G(^(.2)),ND2=$G(^(2))
24 .. S PSJFREQ=$P(ND2,U,6) Q:PSJFREQ'=0
25 .. S PSJSTART=$P(ND2,U,2),PSJSTOP=$P(ND2,U,4) Q:'PSJSTART!(PSJSTART'=PSJSTOP)
26 .. S PSJPRIO=$P(NDPT2,U,4) Q:(PSJPRIO'="D")
27 .. S PSJSCH=$P(ND2,U) Q:",STAT,NOW,"'[(","_PSJSCH_",")
28 .. S CCNT=$G(CCNT)+1
29 .. S ^XTMP("PSJ","FREQ",PSJPDFN,PSJORD)=ND2
30 S:$D(^XTMP("PSJ","FREQ")) ^XTMP("PSJ","FREQ",0)=EXPR_"^"_CREAT
31 D CLEAN
32DONE ;
33 K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
34 Q
35SENDMSG ;Send mail message when check is complete.
36 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*91 INPATIENT MEDS FREQUENCY ORDER CHECK COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
37 S PSG(1,0)="The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
38 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)
39 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)_"."
40 S PSG(6,0)=CCNT_" pharmacy orders were found with a frequency of zero"
41 D ^XMD
42 Q
43 ;
44CLEAN ;
45 N PSJPDFN,PSJORD,PSJDRG,PSJOI,DRG,PSSTART,PSSTOP,PSSTATUS,ORSTART,ORSTOP,ORSTATUS,CHK,CHK3
46 S PSJPDFN=0 F S PSJPDFN=$O(^XTMP("PSJ","FREQ",PSJPDFN)) Q:'PSJPDFN D
47 . S PSJORD=0 F S PSJORD=$O(^XTMP("PSJ","FREQ",PSJPDFN,PSJORD)) Q:'PSJORD D
48 .. I '$D(^PS(55,PSJPDFN,5,PSJORD)) Q
49 .. S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",6)="O"
50 .. ;S DIE="^PS(55,"_PSJPDFN_",5,"
51 .. ;S DA(1)=PSJPDFN,DA=PSJORD,DR="42////O"
52 .. ;D ^DIE
53 I 'CCNT K ^XTMP("PSJ","FREQ")
54 K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*91 INPATIENT MEDS FREQUENCY ORDER CLEANUP COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
55 S PSG(1,0)="The cleanup of Inpatient Medication orders with a frequency of zero ",PSG(2,0)="completed as of "_Y_"."
56 S PSG(3,0)=""
57 S PSG(4,0)=CCNT_" pharmacy orders with a frequency of zero were corrected."
58 D ^XMD
Note: See TracBrowser for help on using the repository browser.