[613] | 1 | PSJADT1 ;BIR/CML3-AUTO CANCEL/HOLD UTILITIES ;17 JAN 96 / 10:11 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**30,37,51,83**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^PS(55 is supported by DBIA# 2191.
|
---|
| 5 | ; Reference to ^PS(59.7 is supported by DBIA# 2181.
|
---|
| 6 | ;
|
---|
| 7 | ENUW ; update ward and treating specialty
|
---|
| 8 | D INP^VADPT,NOW^%DTC F Q1=%:0 S Q1=$O(^PS(55,PSGP,5,"AUS",Q1)) Q:'Q1 F Q2=0:0 S Q2=$O(^PS(55,PSGP,5,"AUS",Q1,Q2)) Q:'Q2 D
|
---|
| 9 | .I $D(^PS(55,PSGP,5,Q2,0)) S $P(^(0),"^",23)=+VAIN(4),^PS(55,"AUE",PSGP,Q2)=""
|
---|
| 10 | F ON=0:0 S ON=$O(^PS(55,PSGP,"IV",ON)) Q:'ON I $D(^(ON,0)) S $P(^(0),"^",22)=+VAIN(4)
|
---|
| 11 | Q
|
---|
| 12 | ;
|
---|
| 13 | ENHOLD(PSGOEHA,PSJDEL,PSJPAD,PSGALO) ;
|
---|
| 14 | ; place orders on/off hold
|
---|
| 15 | S X=PSGOEHA W:'$D(DGQUIET) !,"...",$S(X:"plac",1:"tak"),"ing Inpatient Medication orders o",$S(X:"n",1:"ff")," of hold..."
|
---|
| 16 | D NOW^%DTC S PSGDT=+$E(%,1,12),PSGOEHA='PSGOEHA D ENACH^PSGOEHA
|
---|
| 17 | S DFN=PSGP,PSIVNST="H" I 'PSGOEHA D ^PSIVHLD
|
---|
| 18 | I PSGOEHA D START^PSIVHLD
|
---|
| 19 | I 'PSGOEHA S X=PSJDEL,X=$S(X=3:2,X=22:2,X=26:2,1:1),$P(PSJPIND,"^",7)=2,$P(PSJPIND,"^",10)="Transferred "_$P("A^Una",U,X)_"uthorized Absence" Q
|
---|
| 20 | S $P(PSJPIND,"^",7)="",$P(PSJPIND,"^",10)="" G ENUW
|
---|
| 21 | ;
|
---|
| 22 | ENDEL(DFN,DGPMP,PSJTMT,PSJDEL) ;
|
---|
| 23 | ;Undo mvmt action if movement is deleted.
|
---|
| 24 | N VAIP S VAIP("D")=+DGPMP D IN5^VADPT Q:VAIP(16)
|
---|
| 25 | ; Add call to PSJADT0 to dc active/non-verified orders for cancelled admissions.
|
---|
| 26 | I PSJDEL=1 D Q
|
---|
| 27 | . S PSJPAD=+VAIP(13,1),PSGALO=1035
|
---|
| 28 | . N VAIP D IN5^VADPT Q:+VAIP(13,1)>PSJPAD
|
---|
| 29 | . D ENDC^PSJADT0
|
---|
| 30 | I PSJDEL=3 D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18540) Q
|
---|
| 31 | I PSJDEL=6 D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18550) Q
|
---|
| 32 | I PSJTMT=4 D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18550) Q
|
---|
| 33 | I PSJTMT<4 D
|
---|
| 34 | .I $P($G(^PS(55,DFN,5.1)),U,7),$P(^(5.1),U,10)["Transferred" D ENHOLD(0,PSJDEL,+DGPMP,8090)
|
---|
| 35 | .D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18550)
|
---|
| 36 | I PSJTMT>21,(PSJTMT<27) S X=PSJTMT I $P($G(^PS(59.7,1,22,+VAIP(5),0)),U,$S(X=22!(X=26):4,X=23:2,1:3)) D ENHOLD(1,X,+DGPMP,8590)
|
---|
| 37 | Q
|
---|
| 38 |
|
---|