- 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 Mar 13, 2025@21:10:51 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
