- PSJ0078 ;BIR/LDT-Check for Dispense Drug ;02 MAY 02 / 4:29 PM
- ;;5.0; INPATIENT MEDICATIONS ;**78**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PSDRUG( is supported by DBIA# 2192.
- ; Reference to ^OR(100 is supported by DBIA# 3582.
- ; Reference to $$STATUS^ORQOR2 is supported by DBIA# 3458.
- ;
- 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^PSJ0078",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 2 MAILMAN MESSAGES WHEN TASK #"_ZTSK_" HAS COMPLETED."
- . W !,"IF ERRORS ARE DETECTED, YOU WILL RECEIVE ADDITIONAL MESSAGES INDICATING CLEANUP"
- . W !,"HAS COMPLETED."
- Q
- ENQN ; Check of existing Pharmacy orders.
- N PSJBEG,PSJPDFN,PSJORD,PSJLORD,CREAT,EXPR,OCNT
- D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0),OCNT=0,PSJLORD=0
- K ^XTMP("PSJ")
- S PSJBEG="" F S PSJBEG=$O(^PS(55,"AUD",PSJBEG)) Q:PSJBEG="" 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 Q:'+$G(^PS(55,PSJPDFN,5,PSJORD,.2)) D
- .. S PSJDRG=0 F S PSJDRG=$O(^PS(55,PSJPDFN,5,PSJORD,1,PSJDRG)) Q:'PSJDRG I $P($G(^PS(55,PSJPDFN,5,PSJORD,1,PSJDRG,0)),"^")="" S ^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG)=$P($G(^PS(55,PSJPDFN,5,PSJORD,.2)),"^") S:PSJORD'=PSJLORD OCNT=OCNT+1 D
- ... S PSJLORD=PSJORD I PSJDRG>1 S $P(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),"^",2)="MULTIPLE DISPENSE DRUGS",$P(^XTMP("PSJ",PSJPDFN,PSJORD,1),"^",2)="MULTIPLE DISPENSE DRUGS"
- ... D SET
- 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="@"
- K ^XTMP("PSJ")
- D ENQN^PSJ078A
- K ^XTMP("PSJ"),^XTMP("PSJ XREF")
- Q
- SENDMSG ;Send mail message when check is complete.
- K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*78 INPATIENT MEDS DISPENSE DRUG 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 no Dispense Drug."
- D ^XMD
- Q
- ;
- CLEAN ;
- N PSJPDFN,PSJORD,PSJDRG,PSJOI,DRG,CCNT,LFCNT,PSSTART,PSSTOP,PSSTATUS,ORSTART,ORSTOP,ORSTATUS,CHK,CHK3 S CCNT=0,LFCNT=0
- 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 S PSJDRG=0 F S PSJDRG=$O(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG)) Q:'PSJDRG D
- . I '$D(^PS(55,PSJPDFN,5,PSJORD)) Q
- . I $P(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),U,2)="" S PSJOI=$P(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),U) S:PSJOI]"" DRG=$$CHECK I DRG D
- .. S $P(^PS(55,PSJPDFN,5,PSJORD,1,1,0),U)=DRG,^PS(55,PSJPDFN,5,+PSJORD,1,"B",DRG,1)="" K ^PS(55,PSJPDFN,5,PSJORD,1,"B",0,1) S CCNT=CCNT+1
- .. K DR D NOW^%DTC S PSSTART=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^"),PSSTOP=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^",2),PSSTATUS=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^",3)
- .. S ORSTART=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^"),ORSTOP=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^",2),ORSTATUS=$P($G(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^",3),DIE="^PS(55,"_PSJPDFN_",5,",DA=PSJORD,DA(1)=PSJPDFN
- .. D CHECK2 I CHK,ORSTOP'="",+ORSTOP<+PSSTOP,+ORSTOP<% S STPDT=ORSTOP,DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////^S X=STPDT"
- .. I CHK,ORSTOP'="",+ORSTOP<+PSSTOP,+ORSTOP'<% S STPDT=%,DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////^S X=STPDT"
- .. I CHK,ORSTOP'="",PSSTOP="" S DR="10////^S X=PSSTART;28////D"_$S(ORSTOP<%:";34////^S X=ORSTOP",1:";34////"_%)
- .. I CHK,ORSTOP="",PSSTOP'="",+PSSTOP'>% S DR="10////^S X=PSSTART;28////D;34////^S X=PSSTOP"
- .. I CHK,ORSTOP="",PSSTOP="" S DR="10////^S X=PSSTART;28////D;34////"_%
- .. I CHK,ORSTOP="",+PSSTOP>% S DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////"_%
- .. I CHK,+ORSTOP=+PSSTOP,+PSSTOP<% S DR="10////^S X=PSSTART;28////D;34////^S X=PSSTOP"
- .. I CHK,+ORSTOP=+PSSTOP,+PSSTOP'<% S DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////"_%
- .. I 'CHK S:((PSSTATUS="A")&(+PSSTOP<%)) DR="10////^S X=PSSTART;28////E;34////^S X=PSSTOP" I PSSTATUS="A",+PSSTOP'<% I $$CHECKDUP^PSGOERI(PSJPDFN,PSJORD) S DR="10////^S X=PSSTART;28////D;34////"_%
- .. I 'CHK,PSSTATUS="A",+PSSTOP'<% I '$$CHECKDUP^PSGOERI(PSJPDFN,PSJORD) S DR="10////^S X=PSSTART;34////^S X=PSSTOP"
- .. I 'CHK,PSSTATUS'="A" S DR="10////^S X=PSSTART;34////^S X=PSSTOP"
- .. I $D(DR) D ^DIE
- .. S PSJHLMTN="ORM" D EN1^PSJHL2(PSJPDFN,"SC",PSJORD_"U") K ^XTMP("PSJ",PSJPDFN,PSJORD)
- S PSJPDFN=0 F S PSJPDFN=$O(^XTMP("PSJ",PSJPDFN)) Q:'PSJPDFN S LFCNT=LFCNT+1
- I 'LFCNT K ^XTMP("PSJ")
- K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="PSJ*5*78 INPATIENT MEDS DISPENSE DRUG 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 no Dispense Drugs ",PSG(2,0)="completed as of "_Y_"."
- S PSG(3,0)=""
- S PSG(4,0)=CCNT_" pharmacy orders with no Dispense Drugs were corrected."
- I $D(^XTMP("PSJ")) S PSG(5,0)="",PSG(6,0)="The following orders couldn't be corrected:",MSGCNT=7 D
- . S PSG(7,0)="Patient's DFN Order #"
- . 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
- .. S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)=$J(PSJPDFN,13)_" "_$J(PSJORD,6)_"U"
- .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)=""
- .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)="The person who installs this patch and the pharmacy adpac should work together"
- .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)="to identify what the missing Dispense Drug should be and get the order updated."
- .S MSGCNT=MSGCNT+1,PSG(MSGCNT,0)="Should you require further assistance please contact NVS."
- D ^XMD
- Q
- ;
- CHECK() ;
- I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
- N Q,X,DRG,QPT S (X,Q,QPT)=0
- F DRG=0:0 S DRG=$O(^PSDRUG("ASP",PSJOI,DRG)) Q:'DRG S:$G(^PSDRUG(DRG,"I")) X=^("I")'>PSGDT I $P(^PSDRUG(DRG,2),U,3)["U" S Q=Q+1 S:'X QPT=DRG
- Q $S(Q=1:QPT,1:0)
- SET ;
- S F="^PS(55,"_PSJPDFN_",5,"_PSJORD_","
- S ND=$G(@(F_"0)")),OERR=+$P(ND,"^",21),ND2=$G(@(F_"2)")),PSSTART=$P(ND2,"^",2),PSSTOP=$P(ND2,"^",4),PSSTATUS=$P(ND,"^",9)
- S ORND=$G(^OR(100,OERR,0)),ORND3=$G(^OR(100,OERR,3)),PSPTR=$G(^OR(100,OERR,4)),ORSTART=$P(ORND,"^",8),ORSTOP=$P(ORND,"^",9),ORSTATUS=$P(ORND3,"^",3) Q:'ND D
- .S:'OERR ^XTMP("PSJ",PSJPDFN,PSJORD,3)=OERR_U_PSPTR
- .S:+PSPTR'=PSJORD ^XTMP("PSJ",PSJPDFN,PSJORD,4)=OERR_U_PSPTR_U_$P(ND,"^")
- .S ^XTMP("PSJ",PSJPDFN,PSJORD,5)=PSSTART_U_PSSTOP_U_PSSTATUS,^XTMP("PSJ",PSJPDFN,PSJORD,6)=ORSTART_U_ORSTOP_U_$$STATUS^ORQOR2(OERR)_U_OERR
- Q
- CHECK2 ;
- S CHK=0
- I +PSSTART'=+ORSTART S CHK=1 Q
- I +PSSTOP'=+ORSTOP S CHK=1 Q
- D @PSSTATUS
- Q
- A S:ORSTATUS'=6 CHK=1 Q
- D S:"1^13"'[ORSTATUS CHK=1 Q
- DE S:"1^12^13"'[ORSTATUS CHK=1 Q
- DR S:"1^13^15"'[ORSTATUS CHK=1 Q
- E S:ORSTATUS'=7 CHK=1 Q
- H S:ORSTATUS'=3 CHK=1 Q
- I S:ORSTATUS'=9 CHK=1 Q
- N S:ORSTATUS'=5 CHK=1 Q
- O S:ORSTATUS'=3 CHK=1 Q
- P S:ORSTATUS'=5 CHK=1 Q
- R S:ORSTATUS'=15 CHK=1 Q
- RE S:ORSTATUS'=6 CHK=1 Q
- U S CHK=1 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ0078 7738 printed Apr 23, 2025@18:20 Page 2
- PSJ0078 ;BIR/LDT-Check for Dispense Drug ;02 MAY 02 / 4:29 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**78**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +4 ; Reference to ^PSDRUG( is supported by DBIA# 2192.
- +5 ; Reference to ^OR(100 is supported by DBIA# 3582.
- +6 ; Reference to $$STATUS^ORQOR2 is supported by DBIA# 3458.
- +7 ;
- 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^PSJ0078"
- 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 2 MAILMAN MESSAGES WHEN TASK #"_ZTSK_" HAS COMPLETED."
- +6 WRITE !,"IF ERRORS ARE DETECTED, YOU WILL RECEIVE ADDITIONAL MESSAGES INDICATING CLEANUP"
- +7 WRITE !,"HAS COMPLETED."
- End DoDot:1
- +8 QUIT
- ENQN ; Check of existing Pharmacy orders.
- +1 NEW PSJBEG,PSJPDFN,PSJORD,PSJLORD,CREAT,EXPR,OCNT
- +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
- SET PSJLORD=0
- +3 KILL ^XTMP("PSJ")
- +4 SET PSJBEG=""
- FOR
- SET PSJBEG=$ORDER(^PS(55,"AUD",PSJBEG))
- if PSJBEG=""
- QUIT
- SET PSJPDFN=0
- FOR
- SET PSJPDFN=$ORDER(^PS(55,"AUD",PSJBEG,PSJPDFN))
- if 'PSJPDFN
- QUIT
- Begin DoDot:1
- +5 SET PSJORD=0
- FOR
- SET PSJORD=$ORDER(^PS(55,"AUD",PSJBEG,PSJPDFN,PSJORD))
- if 'PSJORD
- QUIT
- if '+$GET(^PS(55,PSJPDFN,5,PSJORD,.2))
- QUIT
- Begin DoDot:2
- +6 SET PSJDRG=0
- FOR
- SET PSJDRG=$ORDER(^PS(55,PSJPDFN,5,PSJORD,1,PSJDRG))
- if 'PSJDRG
- QUIT
- IF $PIECE($GET(^PS(55,PSJPDFN,5,PSJORD,1,PSJDRG,0)),"^")=""
- SET ^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG)=$PIECE($GET(^PS(55,PSJPDFN,5,PSJORD,.2)),"^")
- if PSJORD'=PSJLORD
- SET OCNT=OCNT+1
- Begin DoDot:3
- +7 SET PSJLORD=PSJORD
- IF PSJDRG>1
- SET $PIECE(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),"^",2)="MULTIPLE DISPENSE DRUGS"
- SET $PIECE(^XTMP("PSJ",PSJPDFN,PSJORD,1),"^",2)="MULTIPLE DISPENSE DRUGS"
- +8 DO SET
- 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 KILL ^XTMP("PSJ")
- +3 DO ENQN^PSJ078A
- +4 KILL ^XTMP("PSJ"),^XTMP("PSJ XREF")
- +5 QUIT
- SENDMSG ;Send mail message when check is complete.
- +1 KILL PSG,XMY
- SET XMDUZ="MEDICATIONS,INPATIENT"
- SET XMSUB="PSJ*5*78 INPATIENT MEDS DISPENSE DRUG 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 no Dispense Drug."
- +6 DO ^XMD
- +7 QUIT
- +8 ;
- CLEAN ;
- +1 NEW PSJPDFN,PSJORD,PSJDRG,PSJOI,DRG,CCNT,LFCNT,PSSTART,PSSTOP,PSSTATUS,ORSTART,ORSTOP,ORSTATUS,CHK,CHK3
- SET CCNT=0
- SET LFCNT=0
- +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
- SET PSJDRG=0
- FOR
- SET PSJDRG=$ORDER(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG))
- if 'PSJDRG
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^PS(55,PSJPDFN,5,PSJORD))
- QUIT
- +4 IF $PIECE(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),U,2)=""
- SET PSJOI=$PIECE(^XTMP("PSJ",PSJPDFN,PSJORD,PSJDRG),U)
- if PSJOI]""
- SET DRG=$$CHECK
- IF DRG
- Begin DoDot:2
- +5 SET $PIECE(^PS(55,PSJPDFN,5,PSJORD,1,1,0),U)=DRG
- SET ^PS(55,PSJPDFN,5,+PSJORD,1,"B",DRG,1)=""
- KILL ^PS(55,PSJPDFN,5,PSJORD,1,"B",0,1)
- SET CCNT=CCNT+1
- +6 KILL DR
- DO NOW^%DTC
- SET PSSTART=$PIECE($GET(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^")
- SET PSSTOP=$PIECE($GET(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^",2)
- SET PSSTATUS=$PIECE($GET(^XTMP("PSJ",PSJPDFN,PSJORD,5)),"^",3)
- +7 SET ORSTART=$PIECE($GET(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^")
- SET ORSTOP=$PIECE($GET(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^",2)
- SET ORSTATUS=$PIECE($GET(^XTMP("PSJ",PSJPDFN,PSJORD,6)),"^",3)
- SET DIE="^PS(55,"_PSJPDFN_",5,"
- SET DA=PSJORD
- SET DA(1)=PSJPDFN
- +8 DO CHECK2
- IF CHK
- IF ORSTOP'=""
- IF +ORSTOP<+PSSTOP
- IF +ORSTOP<%
- SET STPDT=ORSTOP
- SET DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////^S X=STPDT"
- +9 IF CHK
- IF ORSTOP'=""
- IF +ORSTOP<+PSSTOP
- IF +ORSTOP'<%
- SET STPDT=%
- SET DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////^S X=STPDT"
- +10 IF CHK
- IF ORSTOP'=""
- IF PSSTOP=""
- SET DR="10////^S X=PSSTART;28////D"_$SELECT(ORSTOP<%:";34////^S X=ORSTOP",1:";34////"_%)
- +11 IF CHK
- IF ORSTOP=""
- IF PSSTOP'=""
- IF +PSSTOP'>%
- SET DR="10////^S X=PSSTART;28////D;34////^S X=PSSTOP"
- +12 IF CHK
- IF ORSTOP=""
- IF PSSTOP=""
- SET DR="10////^S X=PSSTART;28////D;34////"_%
- +13 IF CHK
- IF ORSTOP=""
- IF +PSSTOP>%
- SET DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////"_%
- +14 IF CHK
- IF +ORSTOP=+PSSTOP
- IF +PSSTOP<%
- SET DR="10////^S X=PSSTART;28////D;34////^S X=PSSTOP"
- +15 IF CHK
- IF +ORSTOP=+PSSTOP
- IF +PSSTOP'<%
- SET DR="10////^S X=PSSTART;28////D;25////^S X=PSSTOP;34////"_%
- +16 IF 'CHK
- if ((PSSTATUS="A")&(+PSSTOP<%))
- SET DR="10////^S X=PSSTART;28////E;34////^S X=PSSTOP"
- IF PSSTATUS="A"
- IF +PSSTOP'<%
- IF $$CHECKDUP^PSGOERI(PSJPDFN,PSJORD)
- SET DR="10////^S X=PSSTART;28////D;34////"_%
- +17 IF 'CHK
- IF PSSTATUS="A"
- IF +PSSTOP'<%
- IF '$$CHECKDUP^PSGOERI(PSJPDFN,PSJORD)
- SET DR="10////^S X=PSSTART;34////^S X=PSSTOP"
- +18 IF 'CHK
- IF PSSTATUS'="A"
- SET DR="10////^S X=PSSTART;34////^S X=PSSTOP"
- +19 IF $DATA(DR)
- DO ^DIE
- +20 SET PSJHLMTN="ORM"
- DO EN1^PSJHL2(PSJPDFN,"SC",PSJORD_"U")
- KILL ^XTMP("PSJ",PSJPDFN,PSJORD)
- End DoDot:2
- End DoDot:1
- +21 SET PSJPDFN=0
- FOR
- SET PSJPDFN=$ORDER(^XTMP("PSJ",PSJPDFN))
- if 'PSJPDFN
- QUIT
- SET LFCNT=LFCNT+1
- +22 IF 'LFCNT
- KILL ^XTMP("PSJ")
- +23 KILL PSG,XMY
- SET XMDUZ="MEDICATIONS,INPATIENT"
- SET XMSUB="PSJ*5*78 INPATIENT MEDS DISPENSE DRUG ORDER CLEANUP COMPLETED"
- SET XMTEXT="PSG("
- SET XMY(DUZ)=""
- DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- +24 SET PSG(1,0)="The cleanup of Inpatient Medication orders with no Dispense Drugs "
- SET PSG(2,0)="completed as of "_Y_"."
- +25 SET PSG(3,0)=""
- +26 SET PSG(4,0)=CCNT_" pharmacy orders with no Dispense Drugs were corrected."
- +27 IF $DATA(^XTMP("PSJ"))
- SET PSG(5,0)=""
- SET PSG(6,0)="The following orders couldn't be corrected:"
- SET MSGCNT=7
- Begin DoDot:1
- +28 SET PSG(7,0)="Patient's DFN Order #"
- +29 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:2
- +30 SET MSGCNT=MSGCNT+1
- SET PSG(MSGCNT,0)=$JUSTIFY(PSJPDFN,13)_" "_$JUSTIFY(PSJORD,6)_"U"
- End DoDot:2
- +31 SET MSGCNT=MSGCNT+1
- SET PSG(MSGCNT,0)=""
- +32 SET MSGCNT=MSGCNT+1
- SET PSG(MSGCNT,0)="The person who installs this patch and the pharmacy adpac should work together"
- +33 SET MSGCNT=MSGCNT+1
- SET PSG(MSGCNT,0)="to identify what the missing Dispense Drug should be and get the order updated."
- +34 SET MSGCNT=MSGCNT+1
- SET PSG(MSGCNT,0)="Should you require further assistance please contact NVS."
- End DoDot:1
- +35 DO ^XMD
- +36 QUIT
- +37 ;
- CHECK() ;
- +1 IF '$DATA(PSGDT)
- DO NOW^%DTC
- SET PSGDT=$EXTRACT(%,1,12)
- +2 NEW Q,X,DRG,QPT
- SET (X,Q,QPT)=0
- +3 FOR DRG=0:0
- SET DRG=$ORDER(^PSDRUG("ASP",PSJOI,DRG))
- if 'DRG
- QUIT
- if $GET(^PSDRUG(DRG,"I"))
- SET X=^("I")'>PSGDT
- IF $PIECE(^PSDRUG(DRG,2),U,3)["U"
- SET Q=Q+1
- if 'X
- SET QPT=DRG
- +4 QUIT $SELECT(Q=1:QPT,1:0)
- SET ;
- +1 SET F="^PS(55,"_PSJPDFN_",5,"_PSJORD_","
- +2 SET ND=$GET(@(F_"0)"))
- SET OERR=+$PIECE(ND,"^",21)
- SET ND2=$GET(@(F_"2)"))
- SET PSSTART=$PIECE(ND2,"^",2)
- SET PSSTOP=$PIECE(ND2,"^",4)
- SET PSSTATUS=$PIECE(ND,"^",9)
- +3 SET ORND=$GET(^OR(100,OERR,0))
- SET ORND3=$GET(^OR(100,OERR,3))
- SET PSPTR=$GET(^OR(100,OERR,4))
- SET ORSTART=$PIECE(ORND,"^",8)
- SET ORSTOP=$PIECE(ORND,"^",9)
- SET ORSTATUS=$PIECE(ORND3,"^",3)
- if 'ND
- QUIT
- Begin DoDot:1
- +4 if 'OERR
- SET ^XTMP("PSJ",PSJPDFN,PSJORD,3)=OERR_U_PSPTR
- +5 if +PSPTR'=PSJORD
- SET ^XTMP("PSJ",PSJPDFN,PSJORD,4)=OERR_U_PSPTR_U_$PIECE(ND,"^")
- +6 SET ^XTMP("PSJ",PSJPDFN,PSJORD,5)=PSSTART_U_PSSTOP_U_PSSTATUS
- SET ^XTMP("PSJ",PSJPDFN,PSJORD,6)=ORSTART_U_ORSTOP_U_$$STATUS^ORQOR2(OERR)_U_OERR
- End DoDot:1
- +7 QUIT
- CHECK2 ;
- +1 SET CHK=0
- +2 IF +PSSTART'=+ORSTART
- SET CHK=1
- QUIT
- +3 IF +PSSTOP'=+ORSTOP
- SET CHK=1
- QUIT
- +4 DO @PSSTATUS
- +5 QUIT
- A if ORSTATUS'=6
- SET CHK=1
- QUIT
- D if "1^13"'[ORSTATUS
- SET CHK=1
- QUIT
- DE if "1^12^13"'[ORSTATUS
- SET CHK=1
- QUIT
- DR if "1^13^15"'[ORSTATUS
- SET CHK=1
- QUIT
- E if ORSTATUS'=7
- SET CHK=1
- QUIT
- H if ORSTATUS'=3
- SET CHK=1
- QUIT
- I if ORSTATUS'=9
- SET CHK=1
- QUIT
- N if ORSTATUS'=5
- SET CHK=1
- QUIT
- O if ORSTATUS'=3
- SET CHK=1
- QUIT
- P if ORSTATUS'=5
- SET CHK=1
- QUIT
- R if ORSTATUS'=15
- SET CHK=1
- QUIT
- RE if ORSTATUS'=6
- SET CHK=1
- QUIT
- U SET CHK=1
- QUIT
