PSJ005 ;BIR/RSB-UTILITY ROUTINE FOR PATCH PSJ*5*5 ; 03 Jun 98 / 12:06 PM
;;5.0; INPATIENT MEDICATIONS ;**5**; 16 DEC 97
;
FIN ;
; has CPRS main order conversion finished? IF NOT DON'T ASK TIME TO Q
S:'$P($G(^PS(59.7,1,20.5)),"^",2) PSJCONV=1
Q
;
EN ; QUEUE UP CONVERSION FOR UD OUTPATIENT CLEANUP
S:'$P($G(^PS(59.7,1,20.5)),"^",2) PSJCONV=1
I $D(PSJCONV) Q
S ZTIO="",ZTDTH=$S($D(PSJCONV):$H,1:$$CON(XPDQUES("POS ONE")))
S ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
S ZTRTN="START^PSJ005" D ^%ZTLOAD
I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
N PM S PM="This task will find Unit Dose orders that were entered for Outpatients through" D MES^XPDUTL(PM)
S PM="OERR 2.5 and are still pending. The status of these orders will be changed to" D MES^XPDUTL(PM) S PM="Discontinued." D MES^XPDUTL(PM)
;
; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
S ZTIO="",ZTDTH=$S($D(PSJCONV):$H,1:$$CON(XPDQUES("POS ONE")))
S ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
S ZTRTN="START1^PSJ005" D ^%ZTLOAD
;I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
;N PM S PM="This task will correct UD Verification fields cross-references." D MES^XPDUTL(PM)
Q
START ;
N PSJ,PSJ1,PSJ0
F PSJ0="N","P" F PSJ=0:0 S PSJ=$O(^PS(53.1,"AS",PSJ0,PSJ)) Q:'PSJ D
.Q:'$$DISC
.F PSJ1=0:0 S PSJ1=$O(^PS(53.1,"AS",PSJ0,PSJ,PSJ1)) Q:'PSJ1 D
..Q:$$IV
..D DC
Q
;
DISC() ; was the patients last movement a discharge? if not - quit
I $G(^DPT(PSJ,.1))]""
Q '$T
;
IV() ; is the Orderable Item marked for IV use? if yes - quit
N OI S OI=$P($G(^PS(53.1,PSJ1,.2)),"^") I 'OI Q 0
I $P($G(^PS(50.7,OI,0)),"^",3)=1
Q $T
;
DC ; change the orders status to DISCONTINUED!
;
;W !,"DFN= ",PSJ," ",$P(^DPT(PSJ,0),"^")," ^PS(53.1,",PSJ1
S DA=PSJ1,DIE="^PS(53.1,",DR="28////D" D ^DIE K DIE
D EN1^PSJHL2(PSJ,"SC",PSJ1_"P")
Q
;
GETDT ; check date/time for job to run
N %DT,Y S %DT="NRS"
D ^%DT I Y=-1 K X
E S X=Y
Q
CON(X) ;
N %DT S %DT="NRS" D ^%DT
Q Y
;
START1 ;
N DFN,PSJORD
F DFN=0:0 S DFN=$O(^PS(55,"APV",DFN)) Q:'DFN D
.F PSJORD=0:0 S PSJORD=$O(^PS(55,"APV",DFN,PSJORD)) Q:'PSJORD D
..I $P($G(^PS(55,DFN,5,PSJORD,4)),U,3),'$P(^(4),U,9) S $P(^(4),U,9)=1 K ^PS(55,"APV",DFN,PSJORD)
F DFN=0:0 S DFN=$O(^PS(55,"ANV",DFN)) Q:'DFN D
.F PSJORD=0:0 S PSJORD=$O(^PS(55,"ANV",DFN,PSJORD)) Q:'PSJORD D
..I $P($G(^PS(55,DFN,5,PSJORD,4)),U),'$P(^(4),U,10) S $P(^(4),U,10)=1 K ^PS(55,"ANV",DFN,PSJORD)
Q
BADN ; called from BADNAMES^PSJIPST3, when main CPRS is finished
S ZTIO="",ZTDTH=$H
S ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
S ZTRTN="START^PSJ005" D ^%ZTLOAD
;
; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
S ZTIO="",ZTDTH=$H
S ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
S ZTRTN="START1^PSJ005" D ^%ZTLOAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ005 3024 printed Sep 23, 2025@19:41:30 Page 2
PSJ005 ;BIR/RSB-UTILITY ROUTINE FOR PATCH PSJ*5*5 ; 03 Jun 98 / 12:06 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**5**; 16 DEC 97
+2 ;
FIN ;
+1 ; has CPRS main order conversion finished? IF NOT DON'T ASK TIME TO Q
+2 if '$PIECE($GET(^PS(59.7,1,20.5)),"^",2)
SET PSJCONV=1
+3 QUIT
+4 ;
EN ; QUEUE UP CONVERSION FOR UD OUTPATIENT CLEANUP
+1 if '$PIECE($GET(^PS(59.7,1,20.5)),"^",2)
SET PSJCONV=1
+2 IF $DATA(PSJCONV)
QUIT
+3 SET ZTIO=""
SET ZTDTH=$SELECT($DATA(PSJCONV):$HOROLOG,1:$$CON(XPDQUES("POS ONE")))
+4 SET ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
+5 SET ZTRTN="START^PSJ005"
DO ^%ZTLOAD
+6 IF $DATA(ZTSK)
DO MES^XPDUTL(" ")
DO MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$SELECT($DATA(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
+7 NEW PM
SET PM="This task will find Unit Dose orders that were entered for Outpatients through"
DO MES^XPDUTL(PM)
+8 SET PM="OERR 2.5 and are still pending. The status of these orders will be changed to"
DO MES^XPDUTL(PM)
SET PM="Discontinued."
DO MES^XPDUTL(PM)
+9 ;
+10 ; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
+11 SET ZTIO=""
SET ZTDTH=$SELECT($DATA(PSJCONV):$HOROLOG,1:$$CON(XPDQUES("POS ONE")))
+12 SET ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
+13 SET ZTRTN="START1^PSJ005"
DO ^%ZTLOAD
+14 ;I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
+15 ;N PM S PM="This task will correct UD Verification fields cross-references." D MES^XPDUTL(PM)
+16 QUIT
START ;
+1 NEW PSJ,PSJ1,PSJ0
+2 FOR PSJ0="N","P"
FOR PSJ=0:0
SET PSJ=$ORDER(^PS(53.1,"AS",PSJ0,PSJ))
if 'PSJ
QUIT
Begin DoDot:1
+3 if '$$DISC
QUIT
+4 FOR PSJ1=0:0
SET PSJ1=$ORDER(^PS(53.1,"AS",PSJ0,PSJ,PSJ1))
if 'PSJ1
QUIT
Begin DoDot:2
+5 if $$IV
QUIT
+6 DO DC
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
DISC() ; was the patients last movement a discharge? if not - quit
+1 IF $GET(^DPT(PSJ,.1))]""
+2 QUIT '$TEST
+3 ;
IV() ; is the Orderable Item marked for IV use? if yes - quit
+1 NEW OI
SET OI=$PIECE($GET(^PS(53.1,PSJ1,.2)),"^")
IF 'OI
QUIT 0
+2 IF $PIECE($GET(^PS(50.7,OI,0)),"^",3)=1
+3 QUIT $TEST
+4 ;
DC ; change the orders status to DISCONTINUED!
+1 ;
+2 ;W !,"DFN= ",PSJ," ",$P(^DPT(PSJ,0),"^")," ^PS(53.1,",PSJ1
+3 SET DA=PSJ1
SET DIE="^PS(53.1,"
SET DR="28////D"
DO ^DIE
KILL DIE
+4 DO EN1^PSJHL2(PSJ,"SC",PSJ1_"P")
+5 QUIT
+6 ;
GETDT ; check date/time for job to run
+1 NEW %DT,Y
SET %DT="NRS"
+2 DO ^%DT
IF Y=-1
KILL X
+3 IF '$TEST
SET X=Y
+4 QUIT
CON(X) ;
+1 NEW %DT
SET %DT="NRS"
DO ^%DT
+2 QUIT Y
+3 ;
START1 ;
+1 NEW DFN,PSJORD
+2 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,"APV",DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 FOR PSJORD=0:0
SET PSJORD=$ORDER(^PS(55,"APV",DFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:2
+4 IF $PIECE($GET(^PS(55,DFN,5,PSJORD,4)),U,3)
IF '$PIECE(^(4),U,9)
SET $PIECE(^(4),U,9)=1
KILL ^PS(55,"APV",DFN,PSJORD)
End DoDot:2
End DoDot:1
+5 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,"ANV",DFN))
if 'DFN
QUIT
Begin DoDot:1
+6 FOR PSJORD=0:0
SET PSJORD=$ORDER(^PS(55,"ANV",DFN,PSJORD))
if 'PSJORD
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^PS(55,DFN,5,PSJORD,4)),U)
IF '$PIECE(^(4),U,10)
SET $PIECE(^(4),U,10)=1
KILL ^PS(55,"ANV",DFN,PSJORD)
End DoDot:2
End DoDot:1
+8 QUIT
BADN ; called from BADNAMES^PSJIPST3, when main CPRS is finished
+1 SET ZTIO=""
SET ZTDTH=$HOROLOG
+2 SET ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
+3 SET ZTRTN="START^PSJ005"
DO ^%ZTLOAD
+4 ;
+5 ; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
+6 SET ZTIO=""
SET ZTDTH=$HOROLOG
+7 SET ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
+8 SET ZTRTN="START1^PSJ005"
DO ^%ZTLOAD
+9 QUIT
