PSJ5P193 ;NCD - Check for null start date/times ; 2/4/09 11:26am
;;5.0; INPATIENT MEDICATIONS ;**193**;;Build 16
;
; Reference to ^PS(55 is supported by DBIA# 2191.
;Reference to ^PS(50.7 is supported by DBIA# 2180.
;Reference to ^PS(52.6 is supported by DBIA# 1231.
;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.
;Reference to ^DD is supported by DBIA# 10017.
;
ENVN ; 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,ZSTK
S ZTIO="",ZTRTN="START^PSJ5P193",ZTDESC="START DATE CLEAN UP",ZTSAVE("DUZ")="",ZTDTH=$H 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, THE VERIFYING PHARMACIST WILL RECEIVE A MESSAGE INDICATING CLEANUP"
. W !,"HAS COMPLETED."
Q
START ;Check of existing Pharmacy orders.
N XPSJSTDT,XPSJDFN,XPSJON,XPSJLGDT,XPSJSTRT,XPSJSTP,XCNT,XCNTTOT,X,X1,X2,Y,PSJBEG,PSJSTART,CREAT,EXPR,START
S (XPSJSTDT,XPSJDFN,XPSJON,XCNT,XCNTTOT)=0
D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0)
K ^XTMP("PSJ5P193",$J)
;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
. F S XPSJDFN=$O(^PS(55,"AUD",PSJBEG,XPSJDFN)) Q:XPSJDFN="" D
. . F S XPSJON=$O(^PS(55,"AUD",PSJBEG,XPSJDFN,XPSJON)) Q:XPSJON="" D
. . . S XCNTTOT=XCNTTOT+1 I '(XCNTTOT#1000) H .1
. . . S XPSJND2=$G(^PS(55,XPSJDFN,5,XPSJON,2)),XPSJSTRT=$P(XPSJND2,"^",2) ;start date/time
. . . S XPSJLGDT=$P(^PS(55,XPSJDFN,5,XPSJON,0),"^",16) ;login date/time
. . . I XPSJSTRT="" S ^XTMP("PSJ5P193",$J,XPSJDFN,"U",XPSJON)=XPSJSTRT_"^"_XPSJLGDT,XCNT=XCNT+1
S PSJBEG=START,(XPSJDFN,XPSJON)=0
F S PSJBEG=$O(^PS(55,"AIV",PSJBEG)) Q:'PSJBEG D
. F S XPSJDFN=$O(^PS(55,"AIV",PSJBEG,XPSJDFN)) Q:XPSJDFN="" D
. . F S XPSJON=$O(^PS(55,"AIV",PSJBEG,XPSJDFN,XPSJON)) Q:XPSJON="" D
. . . S XPSJN0=$G(^PS(55,XPSJDFN,"IV",XPSJON,0)),XPSJSTRT=$P(XPSJN0,"^",2),XPSJLGDT=$P(^PS(55,XPSJDFN,"IV",XPSJON,2),"^")
. . . I XPSJSTRT="" S ^XTMP("PSJ5P193",$J,XPSJDFN,"I",XPSJON)=XPSJSTRT_"^"_XPSJLGDT,XCNT=XCNT+1
I $D(^XTMP("PSJ5P193")) S ^XTMP("PSJ5P193",$J,0)=EXPR_"^"_CREAT
D SENDMSG
I $D(^XTMP("PSJ5P193",$J)) D CLEAN
END K X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
S:$D(ZTQUEUED) ZTREQ="@"
Q
SENDMSG ;Send mail message when check is complete.
K PSG
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
S XMDUZ="INPATIENT,MEDICATIONS",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)=XCNT_" pharmacy order"_$S(XCNT'=1:"s were ",1:" was ")_" found with invalid start dates."
D ^XMD
Q
;
CLEAN ;
N DFN,X,XPCNT,BLANK,TYP,OI,OINAME,VADM,BEG,END,FSTRT,FSTOP,XPER,XPSJSEND
K PSG
S (XPSJDFN,XPSJON)=0,XPCNT=2,$P(BLANK," ",40)="",BEG=1,END=0
F S XPSJDFN=$O(^XTMP("PSJ5P193",$J,XPSJDFN)) Q:XPSJDFN="" F TYP="U","I" D
. S DFN=XPSJDFN K VADM D DEM^VADPT
. F S XPSJON=$O(^XTMP("PSJ5P193",$J,XPSJDFN,TYP,XPSJON)) Q:XPSJON="" D
. . I '$D(^PS(55,XPSJDFN,$S(TYP="U":5,1:"IV"),XPSJON)) Q
. . K OINAME,FSTRT,FSTOP,XPER
. . S X=^XTMP("PSJ5P193",$J,XPSJDFN,TYP,XPSJON),XPSJSTRT=$P(X,"^"),XPSJLGDT=$P(X,"^",2),XPSJLGTM=$P(XPSJLGDT,".",2)
. . I TYP="U" S OI=$P($G(^PS(55,XPSJDFN,5,XPSJON,.2)),"^"),OINAME=$P($G(^PS(50.7,OI,0)),"^")
. . I TYP="I" S AD=$O(^PS(55,XPSJDFN,"IV",XPSJON,"AD",0)) I AD]"" S AIEN=$P($G(^(AD,0)),"^"),OINAME=$P(^PS(52.6,AIEN,0),"^")
. . ;check if the login time is between midnight and 1:00AM
. . ;if it's not then can't proceed with the correction
. . ;this is a new condition
. . I XPSJSTRT="",XPSJLGDT#1*100'<1 D Q
. . . S XPCNT=XPCNT+1,PSG(XPCNT,0)=$E(VADM(1),1,30)_$E(BLANK,1,32-$L(VADM(1)))_$P(VADM(2),"^")_" "_$S(TYP="U":"Unit Dose",1:"IV")
. . . S XPCNT=XPCNT+1,PSG(XPCNT,0)="can't determine start date. Order: "_XPSJON
. . I TYP="U" D
. . . ;S XPER=$G(^PS(55,XPSJDFN,5,XPSJON,4))
. . . ;I $P(XPER,"^",3)'="" S XPSJSEND($J,$P(XPER,"^",3))="" ;get the verifying pharmacist
. . . S $P(^PS(55,XPSJDFN,5,XPSJON,2),"^",2)=XPSJLGDT
. . . K ^PS(55,"AUDS",0,XPSJDFN,XPSJON)
. . . K DIK,DA S DA=XPSJON,DA(1)=XPSJDFN,DIK="^PS(55,"_DA(1)_",5,",DIK(1)="10^AUDS" D EN^DIK
. . I TYP="I" D
. . . ;S XPER=$G(^PS(55,XPSJDFN,"IV",XPSJON,4))
. . . ;I $P(XPER,"^",4)'="" S XPSJSEND($J,$P(XPER,"^",4))="" ;get the verifying pharmacist
. . . S $P(^PS(55,XPSJDFN,"IV",XPSJON,0),"^",2)=XPSJLGDT
. . . K ^PS(55,"AIVS",0,XPSJDFN,XPSJON)
. . . K DIK,DA S DA=XPSJON,DA(1)=XPSJDFN,DIK="^PS(55,"_DA(1)_",""IV"",",DIK(1)=".02^AIVS" D EN^DIK
. . I TYP="U" S XPSJND2=$G(^PS(55,XPSJDFN,5,XPSJON,2)),XPSJSTRT=$P(XPSJND2,"^",2),XPSJSTP=$P(XPSJND2,"^",4)
. . I TYP="I" S XPSJND0=$G(^PS(55,XPSJDFN,"IV",XPSJON,0)),XPSJSTRT=$P(XPSJND0,"^",2),XPSJSTP=$P(XPSJND0,"^",3)
. . S Y=XPSJSTRT X ^DD("DD") S FSTRT=Y
. . S Y=XPSJSTP X ^DD("DD") S FSTOP=Y
. . S XPCNT=XPCNT+1,PSG(XPCNT,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 XPCNT=XPCNT+1,PSG(XPCNT,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 XPCNT=2,BEG=END+1
D CLEANMSG(BEG,END)
Q
;
CLEANMSG(BEG,END) N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,LOOP
S XMDUZ="INPATIENT,MEDICATIONS",XMSUB="INPATIENT MEDS ORDER "_$S(END>0:BEG_"-"_END_" ",1:"")_"CLEANUP COMPLETED",XMTEXT="PSG("
S LOOP=""
F S LOOP=$O(^XUSEC("PSJ RPHARM",LOOP)) Q:LOOP="" S XMY(LOOP)="" ;send mailman message to all pharmacist who holds PSJ RPHARM key
D NOW^%DTC S Y=% X ^DD("DD")
S PSG(1,0)="The cleanup of Inpatient Medication orders ("_$S(END>0:BEG_"-"_END,1:END)_") of "_XCNT_" orders with invalid ",PSG(2,0)="dates completed as of "_Y_"."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ5P193 6760 printed Dec 13, 2024@02:05:59 Page 2
PSJ5P193 ;NCD - Check for null start date/times ; 2/4/09 11:26am
+1 ;;5.0; INPATIENT MEDICATIONS ;**193**;;Build 16
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191.
+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 ^%DTC is supported by DBIA# 10000.
+7 ;Reference to ^%ZTLOAD is supported by DBIA# 10063.
+8 ;Reference to ^VADPT is supported by DBIA# 10061.
+9 ;Reference to ^XLFDT is supported by DBIA# 10103.
+10 ;Reference to ^XMD is supported by DBIA# 10070.
+11 ;Reference to ^DD is supported by DBIA# 10017.
+12 ;
ENVN ; 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,ZSTK
+3 SET ZTIO=""
SET ZTRTN="START^PSJ5P193"
SET ZTDESC="START DATE CLEAN UP"
SET ZTSAVE("DUZ")=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+4 WRITE !!,"The check of existing Pharmacy orders is",$SELECT($DATA(ZTSK):"",1:" NOT")," queued",!
+5 IF $DATA(ZTSK)
Begin DoDot:1
+6 WRITE " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED. IF"
+7 WRITE !,"ERRORS ARE DETECTED, THE VERIFYING PHARMACIST WILL RECEIVE A MESSAGE INDICATING CLEANUP"
+8 WRITE !,"HAS COMPLETED."
End DoDot:1
+9 QUIT
START ;Check of existing Pharmacy orders.
+1 NEW XPSJSTDT,XPSJDFN,XPSJON,XPSJLGDT,XPSJSTRT,XPSJSTP,XCNT,XCNTTOT,X,X1,X2,Y,PSJBEG,PSJSTART,CREAT,EXPR,START
+2 SET (XPSJSTDT,XPSJDFN,XPSJON,XCNT,XCNTTOT)=0
+3 DO NOW^%DTC
SET PSJSTART=$EXTRACT(%,1,12)
SET CREAT=$EXTRACT(%,1,7)
SET EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0)
+4 KILL ^XTMP("PSJ5P193",$JOB)
+5 ;process the stop date crossreference to find orders
+6 ;with stop dates no more than 30 days old
+7 SET %H=$HOROLOG-31_",86400"
DO YMD^%DTC
SET START=X
+8 SET PSJBEG=START
+9 FOR
SET PSJBEG=$ORDER(^PS(55,"AUD",PSJBEG))
if 'PSJBEG
QUIT
Begin DoDot:1
+10 FOR
SET XPSJDFN=$ORDER(^PS(55,"AUD",PSJBEG,XPSJDFN))
if XPSJDFN=""
QUIT
Begin DoDot:2
+11 FOR
SET XPSJON=$ORDER(^PS(55,"AUD",PSJBEG,XPSJDFN,XPSJON))
if XPSJON=""
QUIT
Begin DoDot:3
+12 SET XCNTTOT=XCNTTOT+1
IF '(XCNTTOT#1000)
HANG .1
+13 ;start date/time
SET XPSJND2=$GET(^PS(55,XPSJDFN,5,XPSJON,2))
SET XPSJSTRT=$PIECE(XPSJND2,"^",2)
+14 ;login date/time
SET XPSJLGDT=$PIECE(^PS(55,XPSJDFN,5,XPSJON,0),"^",16)
+15 IF XPSJSTRT=""
SET ^XTMP("PSJ5P193",$JOB,XPSJDFN,"U",XPSJON)=XPSJSTRT_"^"_XPSJLGDT
SET XCNT=XCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET PSJBEG=START
SET (XPSJDFN,XPSJON)=0
+17 FOR
SET PSJBEG=$ORDER(^PS(55,"AIV",PSJBEG))
if 'PSJBEG
QUIT
Begin DoDot:1
+18 FOR
SET XPSJDFN=$ORDER(^PS(55,"AIV",PSJBEG,XPSJDFN))
if XPSJDFN=""
QUIT
Begin DoDot:2
+19 FOR
SET XPSJON=$ORDER(^PS(55,"AIV",PSJBEG,XPSJDFN,XPSJON))
if XPSJON=""
QUIT
Begin DoDot:3
+20 SET XPSJN0=$GET(^PS(55,XPSJDFN,"IV",XPSJON,0))
SET XPSJSTRT=$PIECE(XPSJN0,"^",2)
SET XPSJLGDT=$PIECE(^PS(55,XPSJDFN,"IV",XPSJON,2),"^")
+21 IF XPSJSTRT=""
SET ^XTMP("PSJ5P193",$JOB,XPSJDFN,"I",XPSJON)=XPSJSTRT_"^"_XPSJLGDT
SET XCNT=XCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF $DATA(^XTMP("PSJ5P193"))
SET ^XTMP("PSJ5P193",$JOB,0)=EXPR_"^"_CREAT
+23 DO SENDMSG
+24 IF $DATA(^XTMP("PSJ5P193",$JOB))
DO CLEAN
END KILL X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
SENDMSG ;Send mail message when check is complete.
+1 KILL PSG
+2 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+3 SET XMDUZ="INPATIENT,MEDICATIONS"
SET XMSUB="INPATIENT MEDS ORDER CHECK COMPLETED"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+4 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_"."
+5 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)
+6 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)_"."
+7 SET PSG(6,0)=XCNT_" pharmacy order"_$SELECT(XCNT'=1:"s were ",1:" was ")_" found with invalid start dates."
+8 DO ^XMD
+9 QUIT
+10 ;
CLEAN ;
+1 NEW DFN,X,XPCNT,BLANK,TYP,OI,OINAME,VADM,BEG,END,FSTRT,FSTOP,XPER,XPSJSEND
+2 KILL PSG
+3 SET (XPSJDFN,XPSJON)=0
SET XPCNT=2
SET $PIECE(BLANK," ",40)=""
SET BEG=1
SET END=0
+4 FOR
SET XPSJDFN=$ORDER(^XTMP("PSJ5P193",$JOB,XPSJDFN))
if XPSJDFN=""
QUIT
FOR TYP="U","I"
Begin DoDot:1
+5 SET DFN=XPSJDFN
KILL VADM
DO DEM^VADPT
+6 FOR
SET XPSJON=$ORDER(^XTMP("PSJ5P193",$JOB,XPSJDFN,TYP,XPSJON))
if XPSJON=""
QUIT
Begin DoDot:2
+7 IF '$DATA(^PS(55,XPSJDFN,$SELECT(TYP="U":5,1:"IV"),XPSJON))
QUIT
+8 KILL OINAME,FSTRT,FSTOP,XPER
+9 SET X=^XTMP("PSJ5P193",$JOB,XPSJDFN,TYP,XPSJON)
SET XPSJSTRT=$PIECE(X,"^")
SET XPSJLGDT=$PIECE(X,"^",2)
SET XPSJLGTM=$PIECE(XPSJLGDT,".",2)
+10 IF TYP="U"
SET OI=$PIECE($GET(^PS(55,XPSJDFN,5,XPSJON,.2)),"^")
SET OINAME=$PIECE($GET(^PS(50.7,OI,0)),"^")
+11 IF TYP="I"
SET AD=$ORDER(^PS(55,XPSJDFN,"IV",XPSJON,"AD",0))
IF AD]""
SET AIEN=$PIECE($GET(^(AD,0)),"^")
SET OINAME=$PIECE(^PS(52.6,AIEN,0),"^")
+12 ;check if the login time is between midnight and 1:00AM
+13 ;if it's not then can't proceed with the correction
+14 ;this is a new condition
+15 IF XPSJSTRT=""
IF XPSJLGDT#1*100'<1
Begin DoDot:3
+16 SET XPCNT=XPCNT+1
SET PSG(XPCNT,0)=$EXTRACT(VADM(1),1,30)_$EXTRACT(BLANK,1,32-$LENGTH(VADM(1)))_$PIECE(VADM(2),"^")_" "_$SELECT(TYP="U":"Unit Dose",1:"IV")
+17 SET XPCNT=XPCNT+1
SET PSG(XPCNT,0)="can't determine start date. Order: "_XPSJON
End DoDot:3
QUIT
+18 IF TYP="U"
Begin DoDot:3
+19 ;S XPER=$G(^PS(55,XPSJDFN,5,XPSJON,4))
+20 ;I $P(XPER,"^",3)'="" S XPSJSEND($J,$P(XPER,"^",3))="" ;get the verifying pharmacist
+21 SET $PIECE(^PS(55,XPSJDFN,5,XPSJON,2),"^",2)=XPSJLGDT
+22 KILL ^PS(55,"AUDS",0,XPSJDFN,XPSJON)
+23 KILL DIK,DA
SET DA=XPSJON
SET DA(1)=XPSJDFN
SET DIK="^PS(55,"_DA(1)_",5,"
SET DIK(1)="10^AUDS"
DO EN^DIK
End DoDot:3
+24 IF TYP="I"
Begin DoDot:3
+25 ;S XPER=$G(^PS(55,XPSJDFN,"IV",XPSJON,4))
+26 ;I $P(XPER,"^",4)'="" S XPSJSEND($J,$P(XPER,"^",4))="" ;get the verifying pharmacist
+27 SET $PIECE(^PS(55,XPSJDFN,"IV",XPSJON,0),"^",2)=XPSJLGDT
+28 KILL ^PS(55,"AIVS",0,XPSJDFN,XPSJON)
+29 KILL DIK,DA
SET DA=XPSJON
SET DA(1)=XPSJDFN
SET DIK="^PS(55,"_DA(1)_",""IV"","
SET DIK(1)=".02^AIVS"
DO EN^DIK
End DoDot:3
+30 IF TYP="U"
SET XPSJND2=$GET(^PS(55,XPSJDFN,5,XPSJON,2))
SET XPSJSTRT=$PIECE(XPSJND2,"^",2)
SET XPSJSTP=$PIECE(XPSJND2,"^",4)
+31 IF TYP="I"
SET XPSJND0=$GET(^PS(55,XPSJDFN,"IV",XPSJON,0))
SET XPSJSTRT=$PIECE(XPSJND0,"^",2)
SET XPSJSTP=$PIECE(XPSJND0,"^",3)
+32 SET Y=XPSJSTRT
XECUTE ^DD("DD")
SET FSTRT=Y
+33 SET Y=XPSJSTP
XECUTE ^DD("DD")
SET FSTOP=Y
+34 SET XPCNT=XPCNT+1
SET PSG(XPCNT,0)=$EXTRACT(VADM(1),1,25)_$EXTRACT(BLANK,1,27-$LENGTH(VADM(1)))_$PIECE(VADM(2),"^")_" "_$SELECT(TYP="U":"Unit Dose",1:"IV")
+35 SET OINAME=$GET(OINAME)
SET FSTRT=$GET(FSTRT)
SET FSTOP=$GET(FSTOP)
+36 SET XPCNT=XPCNT+1
SET PSG(XPCNT,0)=" "_$EXTRACT(OINAME,1,25)_$EXTRACT(BLANK,1,28-$LENGTH(OINAME))_"Start: "_FSTRT_" Stop: "_FSTOP
+37 SET END=END+1
IF '(END#500)
DO CLEANMSG(BEG,END)
KILL PSG
SET XPCNT=2
SET BEG=END+1
End DoDot:2
End DoDot:1
+38 DO CLEANMSG(BEG,END)
+39 QUIT
+40 ;
CLEANMSG(BEG,END) NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,LOOP
+1 SET XMDUZ="INPATIENT,MEDICATIONS"
SET XMSUB="INPATIENT MEDS ORDER "_$SELECT(END>0:BEG_"-"_END_" ",1:"")_"CLEANUP COMPLETED"
SET XMTEXT="PSG("
+2 SET LOOP=""
+3 ;send mailman message to all pharmacist who holds PSJ RPHARM key
FOR
SET LOOP=$ORDER(^XUSEC("PSJ RPHARM",LOOP))
if LOOP=""
QUIT
SET XMY(LOOP)=""
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+5 SET PSG(1,0)="The cleanup of Inpatient Medication orders ("_$SELECT(END>0:BEG_"-"_END,1:END)_") of "_XCNT_" orders with invalid "
SET PSG(2,0)="dates completed as of "_Y_"."
+6 DO ^XMD
+7 QUIT
