- PSJSPU0 ;BIR/CML3-SCHEDULE PROCESSOR UTILITY CONT. ;16 DEC 97 / 1:43 PM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- ENDSD ; calculate default start date
- N %,%H,%I,ET,FT,LT,NT,X,X1,X2,Y D NOW^%DTC
- I $S(PSJTS="O":1,'PSJAT:1,PSJSCH="NOW":1,PSJSCH="STAT":1,PSJSCH="ONCE":1,PSJSCH="ONE-TIME":1,PSJSCH="ONE TIME":1,1:PSJSCH="ON CALL") S PSJX=$E(%,1,10)+($E(%,11,12)>30/100) Q:$P(PSJX,".",2) S X1=PSJX_.24,X2=-1 D C^%DTC S PSJX=X Q
- S NT=%#1,FT="."_$P(PSJAT,"-"),LT="."_$P(PSJAT,"-",$L(PSJAT,"-"))
- I FT=LT S ET=FT,X2=$S(NT>FT:FT+.24-NT<(NT-FT),1:$S(NT+.24-FT<(FT-NT):-1,1:0)) G SADD
- I NT>LT S ET=$S(FT+.24-NT<(NT-LT):FT,1:LT),X2=ET=FT G SADD
- I NT<FT S ET=$S(NT+.24-LT<(FT-NT):LT,1:FT),X2=$S(ET=LT:-1,1:0)
- E S LT=1,X2=0 F F=1:1 S FT="."_$P(PSJAT,"-",F) Q:'FT S TT=FT-NT S:TT<0 TT=-TT S:TT<LT ET=FT,LT=TT
- SADD ;
- S (X,X1)=$P(%,".") D:X2 C^%DTC S PSJX=X_ET
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJSPU0 875 printed Jan 18, 2025@03:10:20 Page 2
- PSJSPU0 ;BIR/CML3-SCHEDULE PROCESSOR UTILITY CONT. ;16 DEC 97 / 1:43 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- ENDSD ; calculate default start date
- +1 NEW %,%H,%I,ET,FT,LT,NT,X,X1,X2,Y
- DO NOW^%DTC
- +2 IF $SELECT(PSJTS="O":1,'PSJAT:1,PSJSCH="NOW":1,PSJSCH="STAT":1,PSJSCH="ONCE":1,PSJSCH="ONE-TIME":1,PSJSCH="ONE TIME":1,1:PSJSCH="ON CALL")
- SET PSJX=$EXTRACT(%,1,10)+($EXTRACT(%,11,12)>30/100)
- if $PIECE(PSJX,".",2)
- QUIT
- SET X1=PSJX_.24
- SET X2=-1
- DO C^%DTC
- SET PSJX=X
- QUIT
- +3 SET NT=%#1
- SET FT="."_$PIECE(PSJAT,"-")
- SET LT="."_$PIECE(PSJAT,"-",$LENGTH(PSJAT,"-"))
- +4 IF FT=LT
- SET ET=FT
- SET X2=$SELECT(NT>FT:FT+.24-NT<(NT-FT),1:$SELECT(NT+.24-FT<(FT-NT):-1,1:0))
- GOTO SADD
- +5 IF NT>LT
- SET ET=$SELECT(FT+.24-NT<(NT-LT):FT,1:LT)
- SET X2=ET=FT
- GOTO SADD
- +6 IF NT<FT
- SET ET=$SELECT(NT+.24-LT<(FT-NT):LT,1:FT)
- SET X2=$SELECT(ET=LT:-1,1:0)
- +7 IF '$TEST
- SET LT=1
- SET X2=0
- FOR F=1:1
- SET FT="."_$PIECE(PSJAT,"-",F)
- if 'FT
- QUIT
- SET TT=FT-NT
- if TT<0
- SET TT=-TT
- if TT<LT
- SET ET=FT
- SET LT=TT
- SADD ;
- +1 SET (X,X1)=$PIECE(%,".")
- if X2
- DO C^%DTC
- SET PSJX=X_ET
- +2 QUIT