- PSSJSPU ;BIR/CML3,WRT-SCHEDULE PROCESSOR UTILITY ; 06/24/96 9:20
- ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/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
- PSSJSPU ;BIR/CML3,WRT-SCHEDULE PROCESSOR UTILITY ; 06/24/96 9:20
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
- +2 ;
- EN ;
- +1 KILL PSJC
- SET PSJC=0
- DO RUN
- +2 ;
- DONE ;
- +1 KILL AM,CD,H,HCD,I,J,M,MID,OD,PDL,ST,Q,QQ,WD,WDT,WS,WS1,X,X1,X2,XX
- QUIT
- +2 ;
- RUN ;
- +1 IF $SELECT(PSJSCH["PRN":1,PSJOFD<PSJSD:1,1:PSJOSD>PSJFD)
- QUIT
- +2 IF $SELECT(PSJTS="O":1,PSJSCH="STAT":1,PSJSCH="NOW":1,PSJSCH="ONCE":1,PSJSCH="ONE-TIME":1,PSJSCH="ON CALL":1,1:PSJSCH="ONE TIME")
- SET PSJC=1
- SET PSJC(+PSJOSD)=""
- QUIT
- +3 SET ST=PSJOSD
- SET CD=$SELECT(PSJFD>PSJOFD:PSJOFD,1:PSJFD)
- SET OD=$SELECT(ST>PSJSD:ST,1:PSJSD)
- SET MID=1
- +4 IF PSJTS="R"
- DO RANGE
- QUIT
- +5 IF PSJTS["S"
- DO SHFT
- QUIT
- +6 IF PSJSCH["@"!(PSJTS["D")
- GOTO MWF
- +7 SET TS=PSJAT
- IF PSJM>1440
- IF TS
- IF '(PSJM#1440)
- GOTO TSFMN
- +8 IF TS>0
- IF "24"[$LENGTH($PIECE(TS,"-"))
- IF PSJSD>ST
- SET ST=PSJSD
- GOTO TS
- +9 IF PSJM'>0
- SET PSJC="-1^PSJM"
- QUIT
- +10 ;
- MN ; minutes (MN) only
- +1 SET (OD,X1)=PSJSD
- SET X2=ST
- DO ^%DTC
- IF X>1
- SET AM=X-1*1440\PSJM*PSJM
- DO ADD
- SET ST=X
- +2 SET (QQ,X)=ST
- FOR I=0:1
- SET AM=PSJM*I
- SET ST=QQ
- IF AM
- DO ADD
- IF X>CD!(CD=PSJOFD&(X'<CD))
- QUIT
- IF X'<OD
- SET PSJC=PSJC+1
- SET PSJC(+X)=""
- +3 QUIT
- +4 ;
- TSFMN ; admin times and minutes#1440=0
- +1 SET X=$PIECE(ST,".")
- SET MID=PSJM\1440
- FOR I=0:1
- SET X1=$PIECE(ST,".")
- SET X2=MID*I
- IF X2
- DO C^%DTC
- IF X'<CD
- QUIT
- IF X'<(PSJSD\1)
- SET ST=$SELECT(PSJSD\1<X:X_.0001,1:PSJSD)
- GOTO TS
- +2 QUIT
- +3 ;
- MTS ;
- +1 SET CD=$SELECT($PIECE(HCD,".")>ST:ST_.24,1:HCD)
- SET ST=$SELECT($PIECE(OD,".")<ST:ST_.0001,1:OD)
- IF PSJTS="DR"
- IF ST'>CD
- SET PSJC=PSJC+1
- SET PSJC(ST)=CD
- QUIT
- +2 ;
- TS ; admin times
- +1 FOR Q=1:1
- SET XX=$PIECE(TS,"-",Q)
- IF XX=""!(("."_XX)'<(ST#1))
- QUIT
- TS1 IF XX=""
- SET X1=$PIECE(ST,".")
- SET X2=MID
- DO C^%DTC
- SET ST=X
- SET Q=1
- +1 FOR QQ=Q:1
- SET XX=$PIECE(TS,"-",QQ)
- IF XX=""
- GOTO TS1
- SET ST=$PIECE(ST,".")_"."_XX
- IF ST>CD!(CD=PSJOFD&(ST'<CD))
- QUIT
- SET PSJC=PSJC+1
- SET PSJC(+ST)=""
- +2 QUIT
- +3 ;
- MWF ;
- +1 IF PSJTS'="DR"
- SET TS=$SELECT(PSJAT:PSJAT,$PIECE(PSJSCH,"@",2):$PIECE(PSJSCH,"@",2),1:$EXTRACT(ST_"00011",9,12))
- +2 SET HCD=CD
- SET WS=$PIECE(PSJSCH,"@")
- SET X=$PIECE(OD,".")
- SET PDL="-"
- IF WS'["-"
- IF WS?.E1P.E
- FOR PSJ1=1:1:$LENGTH(WS)
- IF $EXTRACT(WS,PSJ1)?1P
- SET PDL=$EXTRACT(WS,PSJ1)
- QUIT
- +3 FOR PSJ1=0:1
- SET X1=$PIECE(OD,".")
- SET X2=PSJ1
- IF X2
- DO C^%DTC
- IF X>$PIECE(HCD,".")
- QUIT
- SET ST=X
- DO DW^%DTC
- SET X=X_"S"
- FOR PSJ2=1:1:$LENGTH(WS,PDL)
- IF $PIECE(X,$PIECE(WS,PDL,PSJ2))=""
- DO MTS
- QUIT
- +4 QUIT
- +5 ;
- ADD ;
- +1 IF 'AM
- SET X=ST
- IF 'AM
- QUIT
- SET T=1
- IF AM<0
- SET T=-1
- SET AM=-AM
- SET X2=AM\1440
- SET AM=AM-(X2*1440)
- SET H=AM\60
- SET M=AM#60
- SET HRS=+$EXTRACT(ST_"00",9,10)
- SET MN=+$EXTRACT(ST_"0000",11,12)
- SET X=$PIECE(ST,".")
- +2 IF M
- SET MN=MN+(M*T)
- IF MN>59
- SET MN=MN-60
- SET H=H+1
- IF MN<0
- SET MN=MN+60
- SET H=H+1
- +3 IF H
- SET HRS=HRS+(H*T)
- IF HRS>24!(HRS=24&MN)
- SET HRS=HRS-24
- SET X2=X2+1
- IF HRS<0
- SET HRS=HRS+24
- SET X2=X2+1
- +4 IF X2
- SET X1=$PIECE(X,".")
- SET X2=X2*T
- DO C^%DTC
- +5 SET X=+(X_"."_$EXTRACT(0,HRS<10)_HRS_$EXTRACT(0,MN<10)_MN)
- KILL AM,H,HRS,M,MN,T
- QUIT
- +6 ;
- SHFT ; shift schedules
- +1 KILL TM
- SET TM=""
- FOR
- SET TM=$ORDER(PSJAT(TM))
- IF TM=""
- QUIT
- SET X=$SELECT(TM["-"&TM:TM,1:PSJAT(TM))
- IF $LENGTH($PIECE(X,"-"))=2
- SET X=$PIECE(X,"-")_"00-"_$PIECE(X,"-",2)_"00"
- SET TM(X)=""
- +2 IF OD\1=(CD\1)
- SET TM=""
- FOR
- SET TM=$ORDER(TM(TM))
- IF TM=""
- QUIT
- IF $PIECE(TM,"-",2)<$PIECE(TM,"-")
- SET $PIECE(TM,"-",2)=24
- SET (X1,X2)=OD\1_"."
- SET X1=X1_$PIECE(TM,"-")
- SET X2=X2_$PIECE(TM,"-",2)
- IF X1'>CD
- IF X2'<OD
- SET PSJC=PSJC+1
- SET PSJC(+$SELECT(OD>X1:OD,1:X1))=+$SELECT(CD>X2:X2,1:CD)
- +3 IF OD\1=(CD\1)
- QUIT
- +4 KILL LD
- SET LD(1)=OD
- FOR LD=2:1
- SET X1=OD\1
- SET X2=LD-1
- DO C^%DTC
- SET LD(LD)=X
- IF CD\1=X
- QUIT
- +5 FOR LDC=1:1:LD-1
- SET TM=""
- FOR
- SET TM=$ORDER(TM(TM))
- IF TM=""
- QUIT
- SET X1="."_$PIECE(TM,"-")
- SET X2="."_$PIECE(TM,"-",2)
- DO SHC
- +6 SET TM=""
- FOR
- SET TM=$ORDER(TM(TM))
- IF TM=""
- QUIT
- SET X1="."_$PIECE(TM,"-")
- SET X2="."_$PIECE(TM,"-",2)
- SET X3=CD#1
- IF X2'<X1
- IF X3'<X1
- SET PSJC=PSJC+1
- SET PSJC(CD\1+X1)=$SELECT(X3<X2:CD,1:CD\1+X2)
- +7 QUIT
- +8 ;
- SHC ;
- +1 IF $SELECT(LDC>1:1,X2<X1:1,1:LD(LDC)'>(LD(LDC)\1+X2))
- SET PSJC=PSJC+1
- SET X=$SELECT(LDC>1:LD(LDC)+X1,X1>(LD(LDC)#1):LD(LDC)\1+X1,1:LD(LDC))
- SET Y=LD(X2<X1+LDC)\1+X2
- IF Y>CD
- SET Y=CD
- SET PSJC(X)=Y
- +2 QUIT
- +3 ;
- RANGE ;
- +1 IF 'PSJM
- SET PSJC=PSJC+1
- SET PSJC(OD)=CD
- QUIT
- +2 SET ST=OD
- FOR
- SET AM=PSJM
- DO ADD
- SET PSJC=PSJC+1
- SET PSJC(ST)=$SELECT(X>CD:CD,1:X)
- IF X'<CD
- QUIT
- SET AM=1
- SET ST=X
- DO ADD
- SET ST=X
- +3 QUIT
