PSJ0061 ;BIR/LDT - Check for Trailing Zeros on dates; 02 MAY-01
;;5.0; INPATIENT MEDICATIONS ;**61**;16 DEC 97
;
;Reference to ^PS(55 is supported by DBIA# 2191.
;
ENNV ; Begin check of existing orders
I $G(DUZ)="" W !,"Your user code is undefined. It must be defined to run this routine." Q
K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0061",ZTDESC="Inpatient Orders Check (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
W !!,"The check of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE TWO MAILMAN MESSAGES WHEN TASK #"_ZTSK_" HAS COMPLETED."
Q
ENQN ; Check of existing Pharmacy orders.
N PSJBEG,PSJPDFN,PSJORD,PSJSTRT,PSJSTP,CREAT,EXPR,OCNT,PSJND2
D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0
K ^XTMP("PSJ")
S PSJBEG=0 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
. S PSJORD=0 F S PSJORD=$O(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
.. S PSJND=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJLOG=$P(PSJND,"^",16)
.. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4) D
... I (PSJLOG'=+PSJLOG)!(PSJSTRT'=+PSJSTRT)!(PSJSTP'=+PSJSTP) S ^XTMP("PSJ",PSJPDFN,PSJORD)=PSJSTRT_"^"_PSJSTP_"^"_PSJLOG,OCNT=OCNT+1
S:$D(^XTMP("PSJ")) ^XTMP("PSJ",0)=EXPR_"^"_CREAT
D SENDMSG
I $D(^XTMP("PSJ")) D CLEAN
DONE ;
K DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK S ZTREQ="@"
Q
Q
SENDMSG ;Send mail message when check is complete.
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")
S PSG(1,0)=" The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
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)
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)_"."
S PSG(6,0)=OCNT_" pharmacy orders were found with trailing zeroes in the start,",PSG(7,0)="stop, or log-in date."
D ^XMD
Q
;
CLEAN ;
N PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG
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
. I '$D(^PS(55,PSJPDFN,5,PSJORD)) Q
. S PSJND=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJST=$P(PSJND,"^",7),PSJLOG=$P(PSJND,"^",16)
. S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",4) D
.. I PSJLOG'=+PSJLOG S $P(^PS(55,PSJPDFN,5,PSJORD,0),"^",16)=+PSJLOG
.. I PSJSTRT]"",PSJSTRT'=+PSJSTRT S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT D
... I $D(^PS(55,"AUDS",PSJSTRT,PSJPDFN,PSJORD)) K ^PS(55,"AUDS",PSJSTRT,PSJPDFN,PSJORD) S ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
.. I PSJSTP]"",PSJSTP'=+PSJSTP S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP D
... 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)=""
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")
S PSG(1,0)=" The cleanup of Inpatient Medication orders with invalid dates ",PSG(2,0)="completed as of "_Y_"."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ0061 3567 printed Dec 13, 2024@02:05:25 Page 2
PSJ0061 ;BIR/LDT - Check for Trailing Zeros on dates; 02 MAY-01
+1 ;;5.0; INPATIENT MEDICATIONS ;**61**;16 DEC 97
+2 ;
+3 ;Reference to ^PS(55 is supported by DBIA# 2191.
+4 ;
ENNV ; Begin check of existing orders
+1 IF $GET(DUZ)=""
WRITE !,"Your user code is undefined. It must be defined to run this routine."
QUIT
+2 KILL ZTSAVE,ZTSK
SET ZTRTN="ENQN^PSJ0061"
SET ZTDESC="Inpatient Orders Check (INPATIENT MEDS)"
SET ZTIO=""
DO ^%ZTLOAD
+3 WRITE !!,"The check of existing Pharmacy orders is",$SELECT($DATA(ZTSK):"",1:" NOT")," queued",!
+4 IF $DATA(ZTSK)
WRITE " (to start NOW).",!!,"YOU WILL RECEIVE TWO MAILMAN MESSAGES WHEN TASK #"_ZTSK_" HAS COMPLETED."
+5 QUIT
ENQN ; Check of existing Pharmacy orders.
+1 NEW PSJBEG,PSJPDFN,PSJORD,PSJSTRT,PSJSTP,CREAT,EXPR,OCNT,PSJND2
+2 DO NOW^%DTC
SET PSJSTART=$EXTRACT(%,1,12)
SET CREAT=$EXTRACT(%,1,7)
SET EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0)
SET OCNT=0
+3 KILL ^XTMP("PSJ")
+4 SET PSJBEG=0
FOR
SET PSJBEG=$ORDER(^PS(55,"AUDS",PSJBEG))
if 'PSJBEG
QUIT
SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^PS(55,"AUDS",PSJBEG,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:1
+5 SET PSJORD=0
FOR
SET PSJORD=$ORDER(^PS(55,"AUDS",PSJBEG,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:2
+6 SET PSJND=$GET(^PS(55,PSJPDFN,5,PSJORD,0))
SET PSJLOG=$PIECE(PSJND,"^",16)
+7 SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
SET PSJSTRT=$PIECE(PSJND2,"^",2)
SET PSJSTP=$PIECE(PSJND2,"^",4)
Begin DoDot:3
+8 IF (PSJLOG'=+PSJLOG)!(PSJSTRT'=+PSJSTRT)!(PSJSTP'=+PSJSTP)
SET ^XTMP("PSJ",PSJPDFN,PSJORD)=PSJSTRT_"^"_PSJSTP_"^"_PSJLOG
SET OCNT=OCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+9 if $DATA(^XTMP("PSJ"))
SET ^XTMP("PSJ",0)=EXPR_"^"_CREAT
+10 DO SENDMSG
+11 IF $DATA(^XTMP("PSJ"))
DO CLEAN
DONE ;
+1 KILL DAYS,MINS,HOURS,PSG,PSJSTART,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK
SET ZTREQ="@"
+2 QUIT
+3 QUIT
SENDMSG ;Send mail message when check is complete.
+1 KILL PSG,XMY
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="INPATIENT MEDS ORDER CHECK COMPLETED"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+2 SET PSG(1,0)=" The check of existing Pharmacy orders for use with Inpatient"
SET PSG(2,0)="Medications 5.0 completed as of "_Y_"."
+3 SET X=$$FMDIFF^XLFDT(%,PSJSTART,3)
if $LENGTH(X," ")>1
SET DAYS=+$PIECE(X," ")
SET X=$PIECE(X," ",2)
SET HOURS=+$PIECE(X,":")
SET MINS=+$PIECE(X,":",2)
+4 SET PSG(3,0)=" "
SET PSG(4,0)="This process checked orders for patients in "_$SELECT($GET(DAYS):DAYS_" day"_$EXTRACT("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$EXTRACT("s",HOURS'=1)
SET PSG(5,0)="and "_MINS_" minute"_$EXTRACT("s",MINS'=1)_"."
+5 SET PSG(6,0)=OCNT_" pharmacy orders were found with trailing zeroes in the start,"
SET PSG(7,0)="stop, or log-in date."
+6 DO ^XMD
+7 QUIT
+8 ;
CLEAN ;
+1 NEW PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG
+2 SET PSJPDFN=0
FOR
SET PSJPDFN=$ORDER(^XTMP("PSJ",PSJPDFN))
if 'PSJPDFN
QUIT
SET PSJORD=0
FOR
SET PSJORD=$ORDER(^XTMP("PSJ",PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:1
+3 IF '$DATA(^PS(55,PSJPDFN,5,PSJORD))
QUIT
+4 SET PSJND=$GET(^PS(55,PSJPDFN,5,PSJORD,0))
SET PSJST=$PIECE(PSJND,"^",7)
SET PSJLOG=$PIECE(PSJND,"^",16)
+5 SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
SET PSJSTRT=$PIECE(PSJND2,"^",2)
SET PSJSTP=$PIECE(PSJND2,"^",4)
Begin DoDot:2
+6 IF PSJLOG'=+PSJLOG
SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,0),"^",16)=+PSJLOG
+7 IF PSJSTRT]""
IF PSJSTRT'=+PSJSTRT
SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
Begin DoDot:3
+8 IF $DATA(^PS(55,"AUDS",PSJSTRT,PSJPDFN,PSJORD))
KILL ^PS(55,"AUDS",PSJSTRT,PSJPDFN,PSJORD)
SET ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
End DoDot:3
+9 IF PSJSTP]""
IF PSJSTP'=+PSJSTP
SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP
Begin DoDot:3
+10 IF $DATA(^PS(55,PSJPDFN,5,"AU",PSJST,PSJSTP,PSJORD))
KILL ^PS(55,PSJPDFN,5,"AU",PSJST,PSJSTP,PSJORD)
SET ^PS(55,PSJPDFN,5,"AU",PSJST,+PSJSTP,PSJORD)=""
End DoDot:3
End DoDot:2
End DoDot:1
+11 KILL PSG,XMY
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="INPATIENT MEDS ORDER CLEANUP COMPLETED"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+12 SET PSG(1,0)=" The cleanup of Inpatient Medication orders with invalid dates "
SET PSG(2,0)="completed as of "_Y_"."
+13 DO ^XMD
+14 QUIT
