1 | PSSJSPU ;BIR/CML3,WRT-SCHEDULE PROCESSOR UTILITY ; 06/24/96 9:20
|
---|
2 | ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
|
---|
3 | ;
|
---|
4 | EN ;
|
---|
5 | K PSJC S PSJC=0 D RUN
|
---|
6 | ;
|
---|
7 | DONE ;
|
---|
8 | K AM,CD,H,HCD,I,J,M,MID,OD,PDL,ST,Q,QQ,WD,WDT,WS,WS1,X,X1,X2,XX Q
|
---|
9 | ;
|
---|
10 | RUN ;
|
---|
11 | I $S(PSJSCH["PRN":1,PSJOFD<PSJSD:1,1:PSJOSD>PSJFD) Q
|
---|
12 | 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
|
---|
13 | S ST=PSJOSD,CD=$S(PSJFD>PSJOFD:PSJOFD,1:PSJFD),OD=$S(ST>PSJSD:ST,1:PSJSD),MID=1
|
---|
14 | I PSJTS="R" D RANGE Q
|
---|
15 | I PSJTS["S" D SHFT Q
|
---|
16 | I PSJSCH["@"!(PSJTS["D") G MWF
|
---|
17 | S TS=PSJAT I PSJM>1440,TS,'(PSJM#1440) G TSFMN
|
---|
18 | I TS>0,"24"[$L($P(TS,"-")) S:PSJSD>ST ST=PSJSD G TS
|
---|
19 | I PSJM'>0 S PSJC="-1^PSJM" Q
|
---|
20 | ;
|
---|
21 | MN ; minutes (MN) only
|
---|
22 | S (OD,X1)=PSJSD,X2=ST D ^%DTC I X>1 S AM=X-1*1440\PSJM*PSJM D ADD S ST=X
|
---|
23 | 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)=""
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | TSFMN ; admin times and minutes#1440=0
|
---|
27 | 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
|
---|
28 | Q
|
---|
29 | ;
|
---|
30 | MTS ;
|
---|
31 | 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
|
---|
32 | ;
|
---|
33 | TS ; admin times
|
---|
34 | F Q=1:1 S XX=$P(TS,"-",Q) Q:XX=""!(("."_XX)'<(ST#1))
|
---|
35 | TS1 I XX="" S X1=$P(ST,"."),X2=MID D C^%DTC S ST=X,Q=1
|
---|
36 | 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)=""
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | MWF ;
|
---|
40 | I PSJTS'="DR" S TS=$S(PSJAT:PSJAT,$P(PSJSCH,"@",2):$P(PSJSCH,"@",2),1:$E(ST_"00011",9,12))
|
---|
41 | 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
|
---|
42 | 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
|
---|
43 | Q
|
---|
44 | ;
|
---|
45 | ADD ;
|
---|
46 | 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,".")
|
---|
47 | 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
|
---|
48 | 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
|
---|
49 | I X2 S X1=$P(X,"."),X2=X2*T D C^%DTC
|
---|
50 | S X=+(X_"."_$E(0,HRS<10)_HRS_$E(0,MN<10)_MN) K AM,H,HRS,M,MN,T Q
|
---|
51 | ;
|
---|
52 | SHFT ; shift schedules
|
---|
53 | 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)=""
|
---|
54 | 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)
|
---|
55 | Q:OD\1=(CD\1)
|
---|
56 | 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
|
---|
57 | 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
|
---|
58 | 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)
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | SHC ;
|
---|
62 | 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
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | RANGE ;
|
---|
66 | I 'PSJM S PSJC=PSJC+1,PSJC(OD)=CD Q
|
---|
67 | 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
|
---|
68 | Q
|
---|