Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJ005

PSJ005.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. FIN ;
  1. ; has CPRS main order conversion finished? IF NOT DON'T ASK TIME TO Q
  1. S:'$P($G(^PS(59.7,1,20.5)),"^",2) PSJCONV=1
  1. Q
  1. ;
  1. EN ; QUEUE UP CONVERSION FOR UD OUTPATIENT CLEANUP
  1. S:'$P($G(^PS(59.7,1,20.5)),"^",2) PSJCONV=1
  1. I $D(PSJCONV) Q
  1. S ZTIO="",ZTDTH=$S($D(PSJCONV):$H,1:$$CON(XPDQUES("POS ONE")))
  1. S ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
  1. S ZTRTN="START^PSJ005" D ^%ZTLOAD
  1. I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
  1. N PM S PM="This task will find Unit Dose orders that were entered for Outpatients through" D MES^XPDUTL(PM)
  1. 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)
  1. ;
  1. ; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
  1. S ZTIO="",ZTDTH=$S($D(PSJCONV):$H,1:$$CON(XPDQUES("POS ONE")))
  1. S ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
  1. S ZTRTN="START1^PSJ005" D ^%ZTLOAD
  1. ;I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
  1. ;N PM S PM="This task will correct UD Verification fields cross-references." D MES^XPDUTL(PM)
  1. Q
  1. START ;
  1. N PSJ,PSJ1,PSJ0
  1. F PSJ0="N","P" F PSJ=0:0 S PSJ=$O(^PS(53.1,"AS",PSJ0,PSJ)) Q:'PSJ D
  1. .Q:'$$DISC
  1. .F PSJ1=0:0 S PSJ1=$O(^PS(53.1,"AS",PSJ0,PSJ,PSJ1)) Q:'PSJ1 D
  1. ..Q:$$IV
  1. ..D DC
  1. Q
  1. ;
  1. DISC() ; was the patients last movement a discharge? if not - quit
  1. I $G(^DPT(PSJ,.1))]""
  1. Q '$T
  1. ;
  1. IV() ; is the Orderable Item marked for IV use? if yes - quit
  1. N OI S OI=$P($G(^PS(53.1,PSJ1,.2)),"^") I 'OI Q 0
  1. I $P($G(^PS(50.7,OI,0)),"^",3)=1
  1. Q $T
  1. ;
  1. DC ; change the orders status to DISCONTINUED!
  1. ;
  1. ;W !,"DFN= ",PSJ," ",$P(^DPT(PSJ,0),"^")," ^PS(53.1,",PSJ1
  1. S DA=PSJ1,DIE="^PS(53.1,",DR="28////D" D ^DIE K DIE
  1. D EN1^PSJHL2(PSJ,"SC",PSJ1_"P")
  1. Q
  1. ;
  1. GETDT ; check date/time for job to run
  1. N %DT,Y S %DT="NRS"
  1. D ^%DT I Y=-1 K X
  1. E S X=Y
  1. Q
  1. CON(X) ;
  1. N %DT S %DT="NRS" D ^%DT
  1. Q Y
  1. ;
  1. START1 ;
  1. N DFN,PSJORD
  1. F DFN=0:0 S DFN=$O(^PS(55,"APV",DFN)) Q:'DFN D
  1. .F PSJORD=0:0 S PSJORD=$O(^PS(55,"APV",DFN,PSJORD)) Q:'PSJORD D
  1. ..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)
  1. F DFN=0:0 S DFN=$O(^PS(55,"ANV",DFN)) Q:'DFN D
  1. .F PSJORD=0:0 S PSJORD=$O(^PS(55,"ANV",DFN,PSJORD)) Q:'PSJORD D
  1. ..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)
  1. Q
  1. BADN ; called from BADNAMES^PSJIPST3, when main CPRS is finished
  1. S ZTIO="",ZTDTH=$H
  1. S ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
  1. S ZTRTN="START^PSJ005" D ^%ZTLOAD
  1. ;
  1. ; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
  1. S ZTIO="",ZTDTH=$H
  1. S ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
  1. S ZTRTN="START1^PSJ005" D ^%ZTLOAD
  1. Q