PSJ0066 ;BIR/JLC - Check for null start dates/times ; 28-NOV-01
;;5.0; INPATIENT MEDICATIONS ;**66**;16 DEC 97
;
;Reference to ^DD is supported by DBIA# 10017.
;Reference to ^PS(50.7 is supported by DBIA# 2180.
;Reference to ^PS(52.6 is supported by DBIA# 1231.
;Reference to ^PS(55 is supported by DBIA# 2191.
;Reference to ^%DTC is supported by DBIA# 10000.
;Reference to ^%ZTLOAD is supported by DBIA# 10063.
;Reference to ^VADPT is supported by DBIA# 10061.
;Reference to ^XLFDT is supported by DBIA# 10103.
;Reference to ^XMD is supported by DBIA# 10070.
;
ENNV ; Begin check of existing orders
I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
K ZTSAVE,ZTSK S ZTRTN="ENQN^PSJ0066",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) D
. W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED. IF"
. W !,"ERRORS ARE DETECTED, YOU WILL RECEIVE A SECOND MESSAGE INDICATING CLEANUP"
. W !,"HAS COMPLETED."
Q
ENQN ; Check of existing Pharmacy orders.
N PSJBEG,PSJPDFN,PSJORD,PSJSTRT,CREAT,EXPR,OCNT,PSJND0,PSJND2,START
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")
;process the stop date crossreference to find orders
;with stop dates no more than 30 days old
S %H=$H-31_",86400" D YMD^%DTC S START=X
S PSJBEG=START
F S PSJBEG=$O(^PS(55,"AUD",PSJBEG)) Q:'PSJBEG D
. S PSJPDFN=0
. F S PSJPDFN=$O(^PS(55,"AUD",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,"AUD",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
... S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2)
... I PSJSTRT=""!($P(PSJSTRT,".",2)="") S ^XTMP("PSJ",PSJPDFN,"U",PSJORD)=PSJSTRT,OCNT=OCNT+1
S PSJBEG=START
F S PSJBEG=$O(^PS(55,"AIV",PSJBEG)) Q:'PSJBEG D
. S PSJPDFN=0
. F S PSJPDFN=$O(^PS(55,"AIV",PSJBEG,PSJPDFN)) Q:'PSJPDFN D
.. S PSJORD=0
.. F S PSJORD=$O(^PS(55,"AIV",PSJBEG,PSJPDFN,PSJORD)) Q:'PSJORD D
... S PSJND0=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),PSJSTRT=$P(PSJND0,"^",2)
... I PSJSTRT=""!($P(PSJSTRT,".",2)="") S ^XTMP("PSJ",PSJPDFN,"I",PSJORD)=PSJSTRT,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
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 invalid start dates."
D ^XMD
Q
;
CLEAN ;
N PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG,Y,PSJOSTP,PSJPREV,AD,AIEN,BEG,END,DFN,FO,FSTOP,FSTRT,PCNT,PREV0,PREV2,RFO,OPSJSTRT,TYP,OI,OINAME,BLANK
S PSJPDFN=0,BEG=1,END=0,PCNT=2,$P(BLANK," ",40)=""
F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN S PSJORD=0 F TYP="U","I" D
. S DFN=PSJPDFN K VADM D DEM^VADPT
. F S PSJORD=$O(^XTMP("PSJ",PSJPDFN,TYP,PSJORD)) Q:'PSJORD D
.. I '$D(^PS(55,PSJPDFN,$S(TYP="U":5,1:"IV"),PSJORD)) Q
.. K OINAME,FSTRT,FSTOP
.. I TYP="U" D
... S PSJND=$G(^PS(55,PSJPDFN,5,PSJORD,0)),PSJST=$P(PSJND,"^",7),PSJPREV=+$P(PSJND,"^",25)
... S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),(PSJSTRT,OPSJSTRT)=$P(PSJND2,"^",2)
... S OI=$P($G(^PS(55,PSJPDFN,5,PSJORD,.2)),"^"),OINAME=$P($G(^PS(50.7,OI,0)),"^")
... S PREV0=$G(^PS(55,PSJPDFN,5,PSJPREV,0)),FO=$P(PREV0,"^",26),RFO=$P(PREV0,"^",27)
... S PSJOSTP=$P($G(^PS(55,PSJPDFN,5,PSJPREV,2)),"^",4)
.. I TYP="I" D
... S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2),PSJST=$P(PSJND,"^",17)
... S PSJND2=$G(^PS(55,PSJPDFN,"IV",PSJORD,2)),PSJPREV=+$P(PSJND2,"^",5)
... 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),"^")
... S PREV2=$G(^PS(55,PSJPDFN,"IV",PSJPREV,2)),FO=$P(PREV2,"^",6),RFO=$P(PREV2,"^",9)
... S PSJOSTP=$P($G(^PS(55,PSJPDFN,"IV",PSJPREV,0)),"^",3)
.. ;if there's a null start date, check if the previous order was
.. ;renewed to cause this order to be created and if the stop date
.. ;is there, use it
.. I PSJSTRT="",PSJPREV D
... I +FO'=+PSJORD!(RFO'="R") Q
... I TYP="U" D
.... S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJOSTP
.... I OPSJSTRT]"" K ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
.... S ^PS(55,"AUDS",+PSJOSTP,PSJPDFN,PSJORD)=""
... I TYP="I" D
.... S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJOSTP
.... I OPSJSTRT]"" K ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
.... S ^PS(55,"AIVS",+PSJOSTP,PSJPDFN,PSJORD)=""
.. ;check to be sure the start date on the order exists
.. ;if it doesn't, can't proceed with the correction
.. ;this is a new condition
.. I TYP="U" S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),(PSJSTRT,OPSJSTRT)=$P(PSJND2,"^",2) I PSJSTRT'[".",$L(PSJSTRT)>7 S PSJSTRT=$E(PSJSTRT,1,7)
.. I TYP="I" S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2) I PSJSTRT'[".",$L(PSJSTRT)>7 S PSJSTRT=$E(PSJSTRT,1,7)
.. I PSJSTRT="" D Q
... S PCNT=PCNT+1,PSG(PCNT,0)=$E(VADM(1),1,30)_$E(BLANK,1,32-$L(VADM(1)))_$P(VADM(2),"^")_" "_$S(TYP="U":"Unit Dose",1:"IV")
... S PCNT=PCNT+1,PSG(PCNT,0)="can't determine start date. Order: "_PSJORD
.. ;check to be sure the start date (even if
.. ;acquired from a previous order) has a time on it
.. ;if not, make it midnight
.. I $P(PSJSTRT,".",2)="" S $P(PSJSTRT,".",2)=24
.. I TYP="U" D
... S $P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
... K ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
... S ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
.. I TYP="I" D
... S $P(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJSTRT
... K ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
... S ^PS(55,"AIVS",+PSJSTRT,PSJPDFN,PSJORD)=""
.. I TYP="U" S PSJND2=$G(^PS(55,PSJPDFN,5,PSJORD,2)),PSJSTRT=$P(PSJND2,"^",2),PSJSTP=$P(PSJND2,"^",3)
.. I TYP="I" S PSJND=$G(^PS(55,PSJPDFN,"IV",PSJORD,0)),(PSJSTRT,OPSJSTRT)=$P(PSJND,"^",2),PSJSTP=$P(PSJND,"^",3)
.. S Y=PSJSTRT X ^DD("DD") S FSTRT=Y
.. S Y=PSJSTP X ^DD("DD") S FSTOP=Y
.. S PCNT=PCNT+1,PSG(PCNT,0)=$E(VADM(1),1,25)_$E(BLANK,1,27-$L(VADM(1)))_$P(VADM(2),"^")_" "_$S(TYP="U":"Unit Dose",1:"IV")
.. S OINAME=$G(OINAME),FSTRT=$G(FSTRT),FSTOP=$G(FSTOP)
.. S PCNT=PCNT+1,PSG(PCNT,0)=" "_$E(OINAME,1,25)_$E(BLANK,1,28-$L(OINAME))_"Start: "_FSTRT_" Stop: "_FSTOP
.. S END=END+1 I '(END#500) D CLEANMSG(BEG,END) K PSG S PCNT=2,BEG=END+1
D CLEANMSG(BEG,END) Q
CLEANMSG(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")
S PSG(1,0)=" The cleanup of Inpatient Medication orders ("_BEG_"-"_END_") with invalid dates ",PSG(2,0)="completed as of "_Y_"."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ0066 7448 printed Nov 22, 2024@17:15:32 Page 2
PSJ0066 ;BIR/JLC - Check for null start dates/times ; 28-NOV-01
+1 ;;5.0; INPATIENT MEDICATIONS ;**66**;16 DEC 97
+2 ;
+3 ;Reference to ^DD is supported by DBIA# 10017.
+4 ;Reference to ^PS(50.7 is supported by DBIA# 2180.
+5 ;Reference to ^PS(52.6 is supported by DBIA# 1231.
+6 ;Reference to ^PS(55 is supported by DBIA# 2191.
+7 ;Reference to ^%DTC is supported by DBIA# 10000.
+8 ;Reference to ^%ZTLOAD is supported by DBIA# 10063.
+9 ;Reference to ^VADPT is supported by DBIA# 10061.
+10 ;Reference to ^XLFDT is supported by DBIA# 10103.
+11 ;Reference to ^XMD is supported by DBIA# 10070.
+12 ;
ENNV ; Begin check of existing orders
+1 IF $GET(DUZ)=""
WRITE !,"Your DUZ is not defined. It must be defined to run this routine."
QUIT
+2 KILL ZTSAVE,ZTSK
SET ZTRTN="ENQN^PSJ0066"
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)
Begin DoDot:1
+5 WRITE " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED. IF"
+6 WRITE !,"ERRORS ARE DETECTED, YOU WILL RECEIVE A SECOND MESSAGE INDICATING CLEANUP"
+7 WRITE !,"HAS COMPLETED."
End DoDot:1
+8 QUIT
ENQN ; Check of existing Pharmacy orders.
+1 NEW PSJBEG,PSJPDFN,PSJORD,PSJSTRT,CREAT,EXPR,OCNT,PSJND0,PSJND2,START
+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 ;process the stop date crossreference to find orders
+5 ;with stop dates no more than 30 days old
+6 SET %H=$HOROLOG-31_",86400"
DO YMD^%DTC
SET START=X
+7 SET PSJBEG=START
+8 FOR
SET PSJBEG=$ORDER(^PS(55,"AUD",PSJBEG))
if 'PSJBEG
QUIT
Begin DoDot:1
+9 SET PSJPDFN=0
+10 FOR
SET PSJPDFN=$ORDER(^PS(55,"AUD",PSJBEG,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+11 SET PSJORD=0
+12 FOR
SET PSJORD=$ORDER(^PS(55,"AUD",PSJBEG,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+13 SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
SET PSJSTRT=$PIECE(PSJND2,"^",2)
+14 IF PSJSTRT=""!($PIECE(PSJSTRT,".",2)="")
SET ^XTMP("PSJ",PSJPDFN,"U",PSJORD)=PSJSTRT
SET OCNT=OCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET PSJBEG=START
+16 FOR
SET PSJBEG=$ORDER(^PS(55,"AIV",PSJBEG))
if 'PSJBEG
QUIT
Begin DoDot:1
+17 SET PSJPDFN=0
+18 FOR
SET PSJPDFN=$ORDER(^PS(55,"AIV",PSJBEG,PSJPDFN))
if 'PSJPDFN
QUIT
Begin DoDot:2
+19 SET PSJORD=0
+20 FOR
SET PSJORD=$ORDER(^PS(55,"AIV",PSJBEG,PSJPDFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:3
+21 SET PSJND0=$GET(^PS(55,PSJPDFN,"IV",PSJORD,0))
SET PSJSTRT=$PIECE(PSJND0,"^",2)
+22 IF PSJSTRT=""!($PIECE(PSJSTRT,".",2)="")
SET ^XTMP("PSJ",PSJPDFN,"I",PSJORD)=PSJSTRT
SET OCNT=OCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+23 if $DATA(^XTMP("PSJ"))
SET ^XTMP("PSJ",0)=EXPR_"^"_CREAT
+24 DO SENDMSG
+25 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
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 invalid start dates."
+6 DO ^XMD
+7 QUIT
+8 ;
CLEAN ;
+1 NEW PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG,Y,PSJOSTP,PSJPREV,AD,AIEN,BEG,END,DFN,FO,FSTOP,FSTRT,PCNT,PREV0,PREV2,RFO,OPSJSTRT,TYP,OI,OINAME,BLANK
+2 SET PSJPDFN=0
SET BEG=1
SET END=0
SET PCNT=2
SET $PIECE(BLANK," ",40)=""
+3 FOR
SET PSJPDFN=$ORDER(^XTMP("PSJ",PSJPDFN))
if 'PSJPDFN
QUIT
SET PSJORD=0
FOR TYP="U","I"
Begin DoDot:1
+4 SET DFN=PSJPDFN
KILL VADM
DO DEM^VADPT
+5 FOR
SET PSJORD=$ORDER(^XTMP("PSJ",PSJPDFN,TYP,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:2
+6 IF '$DATA(^PS(55,PSJPDFN,$SELECT(TYP="U":5,1:"IV"),PSJORD))
QUIT
+7 KILL OINAME,FSTRT,FSTOP
+8 IF TYP="U"
Begin DoDot:3
+9 SET PSJND=$GET(^PS(55,PSJPDFN,5,PSJORD,0))
SET PSJST=$PIECE(PSJND,"^",7)
SET PSJPREV=+$PIECE(PSJND,"^",25)
+10 SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
SET (PSJSTRT,OPSJSTRT)=$PIECE(PSJND2,"^",2)
+11 SET OI=$PIECE($GET(^PS(55,PSJPDFN,5,PSJORD,.2)),"^")
SET OINAME=$PIECE($GET(^PS(50.7,OI,0)),"^")
+12 SET PREV0=$GET(^PS(55,PSJPDFN,5,PSJPREV,0))
SET FO=$PIECE(PREV0,"^",26)
SET RFO=$PIECE(PREV0,"^",27)
+13 SET PSJOSTP=$PIECE($GET(^PS(55,PSJPDFN,5,PSJPREV,2)),"^",4)
End DoDot:3
+14 IF TYP="I"
Begin DoDot:3
+15 SET PSJND=$GET(^PS(55,PSJPDFN,"IV",PSJORD,0))
SET (PSJSTRT,OPSJSTRT)=$PIECE(PSJND,"^",2)
SET PSJST=$PIECE(PSJND,"^",17)
+16 SET PSJND2=$GET(^PS(55,PSJPDFN,"IV",PSJORD,2))
SET PSJPREV=+$PIECE(PSJND2,"^",5)
+17 SET AD=$ORDER(^PS(55,PSJPDFN,"IV",PSJORD,"AD",0))
IF AD]""
SET AIEN=$PIECE($GET(^(AD,0)),"^")
SET OINAME=$PIECE(^PS(52.6,AIEN,0),"^")
+18 SET PREV2=$GET(^PS(55,PSJPDFN,"IV",PSJPREV,2))
SET FO=$PIECE(PREV2,"^",6)
SET RFO=$PIECE(PREV2,"^",9)
+19 SET PSJOSTP=$PIECE($GET(^PS(55,PSJPDFN,"IV",PSJPREV,0)),"^",3)
End DoDot:3
+20 ;if there's a null start date, check if the previous order was
+21 ;renewed to cause this order to be created and if the stop date
+22 ;is there, use it
+23 IF PSJSTRT=""
IF PSJPREV
Begin DoDot:3
+24 IF +FO'=+PSJORD!(RFO'="R")
QUIT
+25 IF TYP="U"
Begin DoDot:4
+26 SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJOSTP
+27 IF OPSJSTRT]""
KILL ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
+28 SET ^PS(55,"AUDS",+PSJOSTP,PSJPDFN,PSJORD)=""
End DoDot:4
+29 IF TYP="I"
Begin DoDot:4
+30 SET $PIECE(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJOSTP
+31 IF OPSJSTRT]""
KILL ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
+32 SET ^PS(55,"AIVS",+PSJOSTP,PSJPDFN,PSJORD)=""
End DoDot:4
End DoDot:3
+33 ;check to be sure the start date on the order exists
+34 ;if it doesn't, can't proceed with the correction
+35 ;this is a new condition
+36 IF TYP="U"
SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
SET (PSJSTRT,OPSJSTRT)=$PIECE(PSJND2,"^",2)
IF PSJSTRT'["."
IF $LENGTH(PSJSTRT)>7
SET PSJSTRT=$EXTRACT(PSJSTRT,1,7)
+37 IF TYP="I"
SET PSJND=$GET(^PS(55,PSJPDFN,"IV",PSJORD,0))
SET (PSJSTRT,OPSJSTRT)=$PIECE(PSJND,"^",2)
IF PSJSTRT'["."
IF $LENGTH(PSJSTRT)>7
SET PSJSTRT=$EXTRACT(PSJSTRT,1,7)
+38 IF PSJSTRT=""
Begin DoDot:3
+39 SET PCNT=PCNT+1
SET PSG(PCNT,0)=$EXTRACT(VADM(1),1,30)_$EXTRACT(BLANK,1,32-$LENGTH(VADM(1)))_$PIECE(VADM(2),"^")_" "_$SELECT(TYP="U":"Unit Dose",1:"IV")
+40 SET PCNT=PCNT+1
SET PSG(PCNT,0)="can't determine start date. Order: "_PSJORD
End DoDot:3
QUIT
+41 ;check to be sure the start date (even if
+42 ;acquired from a previous order) has a time on it
+43 ;if not, make it midnight
+44 IF $PIECE(PSJSTRT,".",2)=""
SET $PIECE(PSJSTRT,".",2)=24
+45 IF TYP="U"
Begin DoDot:3
+46 SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
+47 KILL ^PS(55,"AUDS",OPSJSTRT,PSJPDFN,PSJORD)
+48 SET ^PS(55,"AUDS",+PSJSTRT,PSJPDFN,PSJORD)=""
End DoDot:3
+49 IF TYP="I"
Begin DoDot:3
+50 SET $PIECE(^PS(55,PSJPDFN,"IV",PSJORD,0),"^",2)=+PSJSTRT
+51 KILL ^PS(55,"AIVS",OPSJSTRT,PSJPDFN,PSJORD)
+52 SET ^PS(55,"AIVS",+PSJSTRT,PSJPDFN,PSJORD)=""
End DoDot:3
+53 IF TYP="U"
SET PSJND2=$GET(^PS(55,PSJPDFN,5,PSJORD,2))
SET PSJSTRT=$PIECE(PSJND2,"^",2)
SET PSJSTP=$PIECE(PSJND2,"^",3)
+54 IF TYP="I"
SET PSJND=$GET(^PS(55,PSJPDFN,"IV",PSJORD,0))
SET (PSJSTRT,OPSJSTRT)=$PIECE(PSJND,"^",2)
SET PSJSTP=$PIECE(PSJND,"^",3)
+55 SET Y=PSJSTRT
XECUTE ^DD("DD")
SET FSTRT=Y
+56 SET Y=PSJSTP
XECUTE ^DD("DD")
SET FSTOP=Y
+57 SET PCNT=PCNT+1
SET PSG(PCNT,0)=$EXTRACT(VADM(1),1,25)_$EXTRACT(BLANK,1,27-$LENGTH(VADM(1)))_$PIECE(VADM(2),"^")_" "_$SELECT(TYP="U":"Unit Dose",1:"IV")
+58 SET OINAME=$GET(OINAME)
SET FSTRT=$GET(FSTRT)
SET FSTOP=$GET(FSTOP)
+59 SET PCNT=PCNT+1
SET PSG(PCNT,0)=" "_$EXTRACT(OINAME,1,25)_$EXTRACT(BLANK,1,28-$LENGTH(OINAME))_"Start: "_FSTRT_" Stop: "_FSTOP
+60 SET END=END+1
IF '(END#500)
DO CLEANMSG(BEG,END)
KILL PSG
SET PCNT=2
SET BEG=END+1
End DoDot:2
End DoDot:1
+61 DO CLEANMSG(BEG,END)
QUIT
CLEANMSG(BEG,END) KILL XMY
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="INPATIENT MEDS ORDER ("_BEG_"-"_END_") CLEANUP COMPLETED"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+1 SET PSG(1,0)=" The cleanup of Inpatient Medication orders ("_BEG_"-"_END_") with invalid dates "
SET PSG(2,0)="completed as of "_Y_"."
+2 DO ^XMD
+3 QUIT
