source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJSPU.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: 3.3 KB
Line 
1PSJSPU ;BIR/CML3-SCHEDULE PROCESSOR UTILITY ;16 DEC 97 / 1:44 PM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4EN ;
5 K PSJC S PSJC=0 D RUN
6 ;
7DONE ;
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 ;
10RUN ;
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 ;
21MN ; 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 ;
26TSFMN ; 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 ;
30MTS ;
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 ;
33TS ; admin times
34 F Q=1:1 S XX=$P(TS,"-",Q) Q:XX=""!(("."_XX)'<(ST#1))
35TS1 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 ;
39MWF ;
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 ;
45ADD ;
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 ;
52SHFT ; 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 ;
61SHC ;
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 ;
65RANGE ;
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
Note: See TracBrowser for help on using the repository browser.