CD S:$L(PSGSA)+$L(Y)'>240 PSGSA=PSGSA_$S(PSGSA'="":"."_$P(Y,".",2),1:Y)_" "
"RTN","PSIVWL",48,0)
QSP S PSGCNT=$L(PSGSA," ")-1 K PSIVMI,OD,CD,PSIVSD S:P(7)=1!($G(P("NUMLBL"))=0) PSGCNT=0 Q ;PSJ*5*141 Add P(7) check, *305
"RTN","PSIVWL",49,0)
CHK F Y=1:1 Q:$L(P(11))>240!($P(P(11),"-",Y)="") S $P(P(11),"-",Y)=$P(P(11),"-",Y)_$E("0000",1,4-$L($P(P(11),"-",Y)))
"RTN","PSIVWL",50,0)
Q
"RTN","PSIVWL",51,0)
ENP4 Q:PSIVSD>CD S PSIVSD=OD\1 I $G(P(2)),PSIVSD(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:ADMSD)_"."_ADMTM_" "
"RTN","PSIVWL",59,0)
.. ;F ADM=1:1:$L(P(11),"-") S ADMTM=$P(P(11),"-",ADM) I OD'>(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:PSIVSD)_"."_ADMTM_" "
"RTN","PSIVWL",60,0)
Q:+$G(PSIVX)
"RTN","PSIVWL",61,0)
I '$D(^PS(51.1,"APPSJ",P(9))) S PSIVX=1,P9=$P(P(9),"@") F X=1:1:$L(P9,"-") D Q:'$G(PSIVX)
"RTN","PSIVWL",62,0)
. I '(",MO,TU,WE,TH,FR,SA,SU,"[(","_$P(P9,"-",X)_",")) S PSIVX=0 Q
"RTN","PSIVWL",63,0)
. I ODCDWD[$E($P(P9,"-",X),1,2) D
"RTN","PSIVWL",64,0)
.. S ADMSD=$S($P(ODCDWD,"^")[$P(P9,"-",X):OD,1:CD)\1
"RTN","PSIVWL",65,0)
.. F ADM=1:1:$L(P(11),"-") S ADMTM=$P(P(11),"-",ADM) I OD'>(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:ADMSD)_"."_ADMTM_" "
"RTN","PSIVWL",66,0)
.. ;F ADM=1:1:$L(P(11),"-") S ADMTM=$P(P(11),"-",ADM) I OD'>(ADMSD_"."_ADMTM),(CD'<(ADMSD_"."_ADMTM)) S PSGSA=PSGSA_$S(PSGSA'="":"",1:PSIVSD)_"."_ADMTM_" "
"RTN","PSIVWL",67,0)
Q:+$G(PSIVX)
"RTN","PSIVWL",68,0)
F Y=1:1 S (PSIVMI,MI)=$P(P(11),"-",Y),PSIVSD=+(PSIVSD\1_"."_MI) Q:PSIVSD>CD X:MI="" "S X1=PSIVSD,X2=1 D C^%DTC S PSIVSD=X,Y=0" I MI,PSIVSD'CD,PSIVSD'=P(3),'P(7) S PSGSA=PSGSA_$S(PSGSA'="":"."_$P(PSIVSD,".",2),1:PSIVSD)_" "
"RTN","PSIVWL",69,0)
; INSTALL PRECEEDING LINE WITH VERSION 17.3 OF FILEMAN
"RTN","PSIVWL",70,0)
Q
"RTN","PSIVWL",71,0)
ENT ;PSIVMIN=# of min. to add or sub, PSIVSD=date to add or sub from in FM format -- Answer ret. in 'Y'
"RTN","PSIVWL",72,0)
S X2=PSIVMIN\1440,HOUR=(PSIVMIN-(1440*X2))\60,MIN=(PSIVMIN-(1440*X2)-(60*HOUR))#$S(PSIVMIN<0:-60,1:60),X1=PSIVSD\1,HR=$E(PSIVSD,9,10),MI=$E(PSIVSD,11,12)
"RTN","PSIVWL",73,0)
S:$L(HR)=1 HR=HR_0 S:$L(MI)=1 MI=MI_0 S MI=MI+MIN S:MI>59 MI=MI-60,HR=HR+1
"RTN","PSIVWL",74,0)
S:MI<0 MI=MI+60,HR=HR-1 S HR=HR+HOUR S:HR>23 HR=HR-24,X2=X2+1 S:HR<0 HR=HR+24,X2=X2-1 S:HR+MI=0 X2=X2-1,HR=24,MI=0 S:HR<10 HR=0_HR S:MI<10 MI=0_MI S X=X1 D:X2 C^%DTC S X=$P(X,".") S Y=+(X_"."_HR_MI)
"RTN","PSIVWL",75,0)
; install with version 17.3 of fm
"RTN","PSIVWL",76,0)
K HR,MI,X1,X2,HOUR,MIN,PSIVMIN,O,MI Q
"RTN","PSJADT1")
0^1^B5915914^B5799392
"RTN","PSJADT1",1,0)
PSJADT1 ;BIR/CML3 - AUTO CANCEL/HOLD UTILITIES ;17 JAN 96 / 10:11 AM
"RTN","PSJADT1",2,0)
;;5.0;INPATIENT MEDICATIONS ;**30,37,51,83,350**;16 DEC 97;Build 3
"RTN","PSJADT1",3,0)
;
"RTN","PSJADT1",4,0)
; Reference to ^PS(55 is supported by DBIA# 2191.
"RTN","PSJADT1",5,0)
; Reference to ^PS(59.7 is supported by DBIA# 2181.
"RTN","PSJADT1",6,0)
;
"RTN","PSJADT1",7,0)
ENUW ; update ward and treating specialty
"RTN","PSJADT1",8,0)
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
"RTN","PSJADT1",9,0)
.I $D(^PS(55,PSGP,5,Q2,0)) S $P(^(0),"^",23)=+VAIN(4),^PS(55,"AUE",PSGP,Q2)=""
"RTN","PSJADT1",10,0)
F ON=0:0 S ON=$O(^PS(55,PSGP,"IV",ON)) Q:'ON I $D(^(ON,0)) S $P(^(0),"^",22)=+VAIN(4)
"RTN","PSJADT1",11,0)
Q
"RTN","PSJADT1",12,0)
;
"RTN","PSJADT1",13,0)
ENHOLD(PSGOEHA,PSJDEL,PSJPAD,PSGALO) ;
"RTN","PSJADT1",14,0)
; place orders on/off hold
"RTN","PSJADT1",15,0)
S X=PSGOEHA W:'$D(DGQUIET) !,"...",$S(X:"plac",1:"tak"),"ing Inpatient Medication orders o",$S(X:"n",1:"ff")," of hold..."
"RTN","PSJADT1",16,0)
D NOW^%DTC S PSGDT=+$E(%,1,12),PSGOEHA='PSGOEHA D ENACH^PSGOEHA
"RTN","PSJADT1",17,0)
S DFN=PSGP,PSIVNST="H" I 'PSGOEHA D ^PSIVHLD
"RTN","PSJADT1",18,0)
I PSGOEHA D START^PSIVHLD
"RTN","PSJADT1",19,0)
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
"RTN","PSJADT1",20,0)
S $P(PSJPIND,"^",7)="",$P(PSJPIND,"^",10)="" G ENUW
"RTN","PSJADT1",21,0)
;
"RTN","PSJADT1",22,0)
ENDEL(DFN,DGPMP,PSJTMT,PSJDEL) ;
"RTN","PSJADT1",23,0)
;Undo mvmt action if movement is deleted.
"RTN","PSJADT1",24,0)
N VAIP S VAIP("D")=+DGPMP D IN5^VADPT Q:VAIP(16)
"RTN","PSJADT1",25,0)
; Add call to PSJADT0 to dc active/non-verified orders for cancelled admissions.
"RTN","PSJADT1",26,0)
I PSJDEL=1 D Q
"RTN","PSJADT1",27,0)
. S PSJPAD=+VAIP(13,1),PSGALO=1035
"RTN","PSJADT1",28,0)
. N VAIP D IN5^VADPT Q:+VAIP(13,1)>PSJPAD
"RTN","PSJADT1",29,0)
. D ENDC^PSJADT0
"RTN","PSJADT1",30,0)
I PSJDEL=3 D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18540) Q
"RTN","PSJADT1",31,0)
I PSJDEL=6 D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18550) Q
"RTN","PSJADT1",32,0)
I PSJTMT=4 D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18550) Q
"RTN","PSJADT1",33,0)
I PSJTMT<4 D
"RTN","PSJADT1",34,0)
.I $P($G(^PS(55,DFN,5.1)),U,7),$P(^(5.1),U,10)["Transferred" D ENHOLD(0,PSJDEL,+DGPMP,8090)
"RTN","PSJADT1",35,0)
.S:'$D(VAIP(5)) VAIP(5)=DGPMVI(5)
"RTN","PSJADT1",36,0)
.D ENUNDC^PSJADT0(+DGPMP,DFN,VAIP(5),18550)
"RTN","PSJADT1",37,0)
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)
"RTN","PSJADT1",38,0)
Q
"RTN","PSJADT1",39,0)
"VER")
8.0^22.2
"BLD",10739,6)
^296
**END**
**END**