Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJ0063

PSJ0063.m

Go to the documentation of this file.
  1. PSJ0063 ;BIR/LDT - Check for Trailing Zeros on dates and null start dates; 02 MAY-01
  1. ;;5.0; INPATIENT MEDICATIONS ;**63**;16 DEC 97
  1. ;
  1. ;Reference to ^PS(55 is supported by DBIA# 2191.
  1. ;
  1. ENNV ; Begin check of existing orders
  1. I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
  1. K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0063",ZTDESC="Inpatient Orders Check (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
  1. W !!,"The check of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
  1. I $D(ZTSK) D
  1. . W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED. IF"
  1. . W !,"ERRORS ARE DETECTED, YOU WILL RECEIVE A SECOND MESSAGE INDICATING CLEANUP"
  1. . W !,"HAS COMPLETED."
  1. Q
  1. ENQN ; Check of existing Pharmacy orders.
  1. N PSJBEG,PSJPDFN,PSJORD,PSJSTRT,PSJSTP,CREAT,EXPR,OCNT,PSJND2
  1. D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0
  1. K ^XTMP("PSJ")
  1. S PSJBEG="" F S PSJBEG=$O(^PS(55,"AUDS",PSJBEG)) Q:PSJBEG="" S PSJPDFN=0 F S PSJPDFN=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
  1. . S PSJORD=0 F S PSJORD=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
  1. .. S PSJND=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJLOG=$P(PSJND,"^",16)
  1. .. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4) D
  1. ... I (PSJLOG'=+PSJLOG)!(PSJSTRT'=+PSJSTRT)!(PSJSTP'=+PSJSTP) S ^XTMP("PSJ",PSJPDFN,PSJORD)=PSJSTRT_"^"_PSJSTP_"^"_PSJLOG,OCNT=OCNT+1
  1. S:$D(^XTMP("PSJ")) ^XTMP("PSJ",0)=EXPR_"^"_CREAT
  1. D SENDMSG
  1. I $D(^XTMP("PSJ")) D CLEAN
  1. DONE ;
  1. K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
  1. Q
  1. SENDMSG ;Send mail message when check is complete.
  1. 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")
  1. S PSG(1,0)=" The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
  1. 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)
  1. 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)_"."
  1. S PSG(6,0)=OCNT_" pharmacy orders were found with trailing zeroes/null in the start,",PSG(7,0)="stop, or log-in date."
  1. D ^XMD
  1. Q
  1. ;
  1. CLEAN ;
  1. N PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG,Y,PSJOSTP,PSJPREV,A
  1. 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
  1. . I '$D(^PS(55,PSJPDFN,5,PSJORD)) Q
  1. . S PSJND=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJST=$P(PSJND,"^",7),PSJLOG=$P(PSJND,"^",16),PSJPREV=+$P(PSJND,"^",25)
  1. . S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4) D
  1. .. I PSJLOG'=+PSJLOG S $P(^PS(55,PSJPDFN,5,PSJORD,0),"^",16)=+PSJLOG
  1. .. I PSJSTRT="",PSJPREV D
  1. ... S A=$G(^PS(55,PSJPDFN,5,PSJPREV,0)) I +$P(A,"^",26)'=+PSJORD!($P(A,"^",27)'="R") Q
  1. ... S PSJOSTP=$P(^PS(55,PSJPDFN,5,PSJPREV,2),"^",4),$P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJOSTP
  1. .. I PSJSTRT]"",PSJSTRT'=+PSJSTRT S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT D
  1. ... I $D(^PS(55,"AUDS",PSJSTRT,PSJPDFN,PSJORD)) K ^PS(55,"AUDS",PSJSTRT,PSJPDFN,PSJORD) S ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
  1. .. I PSJSTP]"",PSJSTP'=+PSJSTP S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP D
  1. ... I $D(^PS(55,PSJPDFN,5,"AU",PSJST,PSJSTP,PSJORD)) K ^PS(55,PSJPDFN,5,"AU",PSJST,PSJSTP,PSJORD) S ^PS(55,PSJPDFN,5,"AU",PSJST,+PSJSTP,PSJORD)=""
  1. K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER CLEANUP COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
  1. S PSG(1,0)=" The cleanup of Inpatient Medication orders with invalid dates ",PSG(2,0)="completed as of "_Y_"."
  1. D ^XMD
  1. Q