- PSJ0063 ;BIR/LDT - Check for Trailing Zeros on dates and null start dates; 02 MAY-01
- ;;5.0; INPATIENT MEDICATIONS ;**63**;16 DEC 97
- ;
- ;Reference to ^PS(55 is supported by DBIA# 2191.
- ;
- 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^PSJ0063",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,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="" 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
- 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/null in the start,",PSG(7,0)="stop, or log-in date."
- D ^XMD
- Q
- ;
- CLEAN ;
- N PSJPDFN,PSJORD,PSJND,PSJND2,PSJST,PSJSTRT,PSJSTP,PSJLOG,Y,PSJOSTP,PSJPREV,A
- 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),PSJPREV=+$P(PSJND,"^",25)
- . 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="",PSJPREV D
- ... S A=$G(^PS(55,PSJPDFN,5,PSJPREV,0)) I +$P(A,"^",26)'=+PSJORD!($P(A,"^",27)'="R") Q
- ... S PSJOSTP=$P(^PS(55,PSJPDFN,5,PSJPREV,2),"^",4),$P(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJOSTP
- .. 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[HPSJ0063 3967 printed Jan 18, 2025@03:06:40 Page 2
- PSJ0063 ;BIR/LDT - Check for Trailing Zeros on dates and null start dates; 02 MAY-01
- +1 ;;5.0; INPATIENT MEDICATIONS ;**63**;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 DUZ is not defined. It must be defined to run this routine."
- QUIT
- +2 KILL ZTSAVE,ZTSK
- SET ZTRTN="ENQN^PSJ0063"
- 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,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=""
- 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
- 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/null 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,Y,PSJOSTP,PSJPREV,A
- +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)
- SET PSJPREV=+$PIECE(PSJND,"^",25)
- +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 PSJPREV
- Begin DoDot:3
- +8 SET A=$GET(^PS(55,PSJPDFN,5,PSJPREV,0))
- IF +$PIECE(A,"^",26)'=+PSJORD!($PIECE(A,"^",27)'="R")
- QUIT
- +9 SET PSJOSTP=$PIECE(^PS(55,PSJPDFN,5,PSJPREV,2),"^",4)
- SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJOSTP
- End DoDot:3
- +10 IF PSJSTRT]""
- IF PSJSTRT'=+PSJSTRT
- SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",2)=+PSJSTRT
- Begin DoDot:3
- +11 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
- +12 IF PSJSTP]""
- IF PSJSTP'=+PSJSTP
- SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,2),"^",4)=+PSJSTP
- Begin DoDot:3
- +13 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
- +14 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")
- +15 SET PSG(1,0)=" The cleanup of Inpatient Medication orders with invalid dates "
- SET PSG(2,0)="completed as of "_Y_"."
- +16 DO ^XMD
- +17 QUIT