- 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
- 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
