source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ005.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1PSJ005 ;BIR/RSB-UTILITY ROUTINE FOR PATCH PSJ*5*5 ; 03 Jun 98 / 12:06 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**5**; 16 DEC 97
3 ;
4FIN ;
5 ; has CPRS main order conversion finished? IF NOT DON'T ASK TIME TO Q
6 S:'$P($G(^PS(59.7,1,20.5)),"^",2) PSJCONV=1
7 Q
8 ;
9EN ; QUEUE UP CONVERSION FOR UD OUTPATIENT CLEANUP
10 S:'$P($G(^PS(59.7,1,20.5)),"^",2) PSJCONV=1
11 I $D(PSJCONV) Q
12 S ZTIO="",ZTDTH=$S($D(PSJCONV):$H,1:$$CON(XPDQUES("POS ONE")))
13 S ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
14 S ZTRTN="START^PSJ005" D ^%ZTLOAD
15 I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
16 N PM S PM="This task will find Unit Dose orders that were entered for Outpatients through" D MES^XPDUTL(PM)
17 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)
18 ;
19 ; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
20 S ZTIO="",ZTDTH=$S($D(PSJCONV):$H,1:$$CON(XPDQUES("POS ONE")))
21 S ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
22 S ZTRTN="START1^PSJ005" D ^%ZTLOAD
23 ;I $D(ZTSK) D MES^XPDUTL(" ") D MES^XPDUTL("Task #"_ZTSK_" is queued to run"_$S($D(PSJCONV):" NOW",1:" at "_XPDQUES("POS ONE")))
24 ;N PM S PM="This task will correct UD Verification fields cross-references." D MES^XPDUTL(PM)
25 Q
26START ;
27 N PSJ,PSJ1,PSJ0
28 F PSJ0="N","P" F PSJ=0:0 S PSJ=$O(^PS(53.1,"AS",PSJ0,PSJ)) Q:'PSJ D
29 .Q:'$$DISC
30 .F PSJ1=0:0 S PSJ1=$O(^PS(53.1,"AS",PSJ0,PSJ,PSJ1)) Q:'PSJ1 D
31 ..Q:$$IV
32 ..D DC
33 Q
34 ;
35DISC() ; was the patients last movement a discharge? if not - quit
36 I $G(^DPT(PSJ,.1))]""
37 Q '$T
38 ;
39IV() ; is the Orderable Item marked for IV use? if yes - quit
40 N OI S OI=$P($G(^PS(53.1,PSJ1,.2)),"^") I 'OI Q 0
41 I $P($G(^PS(50.7,OI,0)),"^",3)=1
42 Q $T
43 ;
44DC ; change the orders status to DISCONTINUED!
45 ;
46 ;W !,"DFN= ",PSJ," ",$P(^DPT(PSJ,0),"^")," ^PS(53.1,",PSJ1
47 S DA=PSJ1,DIE="^PS(53.1,",DR="28////D" D ^DIE K DIE
48 D EN1^PSJHL2(PSJ,"SC",PSJ1_"P")
49 Q
50 ;
51GETDT ; check date/time for job to run
52 N %DT,Y S %DT="NRS"
53 D ^%DT I Y=-1 K X
54 E S X=Y
55 Q
56CON(X) ;
57 N %DT S %DT="NRS" D ^%DT
58 Q Y
59 ;
60START1 ;
61 N DFN,PSJORD
62 F DFN=0:0 S DFN=$O(^PS(55,"APV",DFN)) Q:'DFN D
63 .F PSJORD=0:0 S PSJORD=$O(^PS(55,"APV",DFN,PSJORD)) Q:'PSJORD D
64 ..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)
65 F DFN=0:0 S DFN=$O(^PS(55,"ANV",DFN)) Q:'DFN D
66 .F PSJORD=0:0 S PSJORD=$O(^PS(55,"ANV",DFN,PSJORD)) Q:'PSJORD D
67 ..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)
68 Q
69BADN ; called from BADNAMES^PSJIPST3, when main CPRS is finished
70 S ZTIO="",ZTDTH=$H
71 S ZTDESC="Inpatient Medications Patch PSJ*5*5 Unit Dose cleanup"
72 S ZTRTN="START^PSJ005" D ^%ZTLOAD
73 ;
74 ; QUEUE UP CONVERSION FOR PV FLAG CLEANUP
75 S ZTIO="",ZTDTH=$H
76 S ZTDESC="Inpatient Medications Patch PSJ*5*5 PV FLAG cleanup"
77 S ZTRTN="START1^PSJ005" D ^%ZTLOAD
78 Q
Note: See TracBrowser for help on using the repository browser.