PSJSPU0.m

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

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