source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJSPU.m@ 1800

PSJSPU ;BIR/CML3-SCHEDULE PROCESSOR UTILITY ;16 DEC 97 / 1:44 PM 
 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
 ;
EN ;
 K PSJC S PSJC=0 D RUN
 ;
DONE ;
 K AM,CD,H,HCD,I,J,M,MID,OD,PDL,ST,Q,QQ,WD,WDT,WS,WS1,X,X1,X2,XX Q
 ;
RUN ;
 I $S(PSJSCH["PRN":1,PSJOFD<PSJSD:1,1:PSJOSD>PSJFD) Q
 I $S(PSJTS="O":1,PSJSCH="STAT":1,PSJSCH="NOW":1,PSJSCH="ONCE":1,PSJSCH="ONE-TIME":1,PSJSCH="ON CALL":1,1:PSJSCH="ONE TIME") S PSJC=1,PSJC(+PSJOSD)="" Q
 S ST=PSJOSD,CD=$S(PSJFD>PSJOFD:PSJOFD,1:PSJFD),OD=$S(ST>PSJSD:ST,1:PSJSD),MID=1
 I PSJTS="R" D RANGE Q
 I PSJTS["S" D SHFT Q
 I PSJSCH["@"!(PSJTS["D") G MWF
 S TS=PSJAT I PSJM>1440,TS,'(PSJM#1440) G TSFMN
 I TS>0,"24"[$L($P(TS,"-")) S:PSJSD>ST ST=PSJSD G TS
 I PSJM'>0 S PSJC="-1^PSJM" Q
 ;
MN ; minutes (MN) only
 S (OD,X1)=PSJSD,X2=ST D ^%DTC I X>1 S AM=X-1*1440\PSJM*PSJM D ADD S ST=X
 S (QQ,X)=ST F I=0:1 S AM=PSJM*I,ST=QQ D:AM ADD Q:X>CD!(CD=PSJOFD&(X'<CD))  I X'<OD S PSJC=PSJC+1,PSJC(+X)=""
 Q
 ;
TSFMN ; admin times and minutes#1440=0
 S X=$P(ST,"."),MID=PSJM\1440 F I=0:1 S X1=$P(ST,"."),X2=MID*I D:X2 C^%DTC Q:X'<CD  I X'<(PSJSD\1) S ST=$S(PSJSD\1<X:X_.0001,1:PSJSD) G TS
 Q
 ;
MTS ;
 S CD=$S($P(HCD,".")>ST:ST_.24,1:HCD),ST=$S($P(OD,".")<ST:ST_.0001,1:OD) I PSJTS="DR" S:ST'>CD PSJC=PSJC+1,PSJC(ST)=CD Q
 ;
TS ; admin times
 F Q=1:1 S XX=$P(TS,"-",Q) Q:XX=""!(("."_XX)'<(ST#1))
TS1 I XX="" S X1=$P(ST,"."),X2=MID D C^%DTC S ST=X,Q=1
 F QQ=Q:1 S XX=$P(TS,"-",QQ) G:XX="" TS1 S ST=$P(ST,".")_"."_XX Q:ST>CD!(CD=PSJOFD&(ST'<CD))  S PSJC=PSJC+1,PSJC(+ST)=""
 Q
 ;
MWF ;
 I PSJTS'="DR" S TS=$S(PSJAT:PSJAT,$P(PSJSCH,"@",2):$P(PSJSCH,"@",2),1:$E(ST_"00011",9,12))
 S HCD=CD,WS=$P(PSJSCH,"@"),X=$P(OD,"."),PDL="-" I WS'["-",WS?.E1P.E F PSJ1=1:1:$L(WS) I $E(WS,PSJ1)?1P S PDL=$E(WS,PSJ1) Q
 F PSJ1=0:1 S X1=$P(OD,"."),X2=PSJ1 D:X2 C^%DTC Q:X>$P(HCD,".")  S ST=X D DW^%DTC S X=X_"S" F PSJ2=1:1:$L(WS,PDL) I $P(X,$P(WS,PDL,PSJ2))="" D MTS Q
 Q
 ;
ADD ;
 S:'AM X=ST Q:'AM  S T=1 S:AM<0 T=-1,AM=-AM S X2=AM\1440,AM=AM-(X2*1440),H=AM\60,M=AM#60,HRS=+$E(ST_"00",9,10),MN=+$E(ST_"0000",11,12),X=$P(ST,".")
 I M S MN=MN+(M*T) S:MN>59 MN=MN-60,H=H+1 S:MN<0 MN=MN+60,H=H+1
 I H S HRS=HRS+(H*T) S:HRS>24!(HRS=24&MN) HRS=HRS-24,X2=X2+1 S:HRS<0 HRS=HRS+24,X2=X2+1
 I X2 S X1=$P(X,"."),X2=X2*T D C^%DTC
 S X=+(X_"."_$E(0,HRS<10)_HRS_$E(0,MN<10)_MN) K AM,H,HRS,M,MN,T Q
 ;
SHFT ; shift schedules
 K TM S TM="" F  S TM=$O(PSJAT(TM)) Q:TM=""  S X=$S(TM["-"&TM:TM,1:PSJAT(TM)) S:$L($P(X,"-"))=2 X=$P(X,"-")_"00-"_$P(X,"-",2)_"00" S TM(X)=""
 I OD\1=(CD\1) S TM="" F  S TM=$O(TM(TM)) Q:TM=""  S:$P(TM,"-",2)<$P(TM,"-") $P(TM,"-",2)=24 S (X1,X2)=OD\1_".",X1=X1_$P(TM,"-"),X2=X2_$P(TM,"-",2) I X1'>CD,X2'<OD S PSJC=PSJC+1,PSJC(+$S(OD>X1:OD,1:X1))=+$S(CD>X2:X2,1:CD)
 Q:OD\1=(CD\1)
 K LD S LD(1)=OD F LD=2:1 S X1=OD\1,X2=LD-1 D C^%DTC S LD(LD)=X Q:CD\1=X
 F LDC=1:1:LD-1 S TM="" F  S TM=$O(TM(TM)) Q:TM=""  S X1="."_$P(TM,"-"),X2="."_$P(TM,"-",2) D SHC
 S TM="" F  S TM=$O(TM(TM)) Q:TM=""  S X1="."_$P(TM,"-"),X2="."_$P(TM,"-",2),X3=CD#1 I X2'<X1,X3'<X1 S PSJC=PSJC+1,PSJC(CD\1+X1)=$S(X3<X2:CD,1:CD\1+X2)
 Q
 ;
SHC ;
 I $S(LDC>1:1,X2<X1:1,1:LD(LDC)'>(LD(LDC)\1+X2)) S PSJC=PSJC+1,X=$S(LDC>1:LD(LDC)+X1,X1>(LD(LDC)#1):LD(LDC)\1+X1,1:LD(LDC)),Y=LD(X2<X1+LDC)\1+X2 S:Y>CD Y=CD S PSJC(X)=Y
 Q
 ;
RANGE ;
 I 'PSJM S PSJC=PSJC+1,PSJC(OD)=CD Q
 S ST=OD F  S AM=PSJM D ADD S PSJC=PSJC+1,PSJC(ST)=$S(X>CD:CD,1:X) Q:X'<CD  S AM=1,ST=X D ADD S ST=X
 Q