- 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 Feb 18, 2025@23:31:46 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