- YSAST ;ALB/ASF/692/DCL-ASI TIME FUNCTION ;7/30/96 11:20
- ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
- ;CODE TAKEN FROM PRSATIM ROUTINE
- Q
- X(X) Q:$G(X)="" ""
- N X1
- S X=$TR(X,"adimnop","ADIMNOP")
- I X?1"12".A S X=$S(X="12M":"MID",X="12N":"NOON",1:X)
- I X?1.A S X=$S(X["MID":2400,X["NOON":1200,1:"")
- S:$E(X,$L(X))="M" X=$E(X,1,$L(X)-1) S X1=$E(X,$L(X)) I X1?1U,"AP"'[X1 Q ""
- S X1=$P(X,":",2) I X1'="",X1'?2N1.2U Q ""
- I X'?4N,$S($L(+X)<3:+X,1:+X\100)>12 Q ""
- S X=$P(X,":",1)_$P(X,":",2),X1=X
- G:X?4N A I X'?1.4N1.2U Q ""
- S:X<13 X=X*100 I X1["A" Q:X>1259 "" S X=$S(X=1200:2400,X>1159:X-1200,1:X)
- E I X<1200,X1["P"!(X<600) S X=X+1200 I X<1300 Q ""
- A I X>2400!('X&(X'="0000"))!(X#100>59) Q ""
- S X1=+X I 'X1!(X1=1200)!(X1=2400) S X=$S(X1=1200:"NOON",1:"MID") Q X
- S X1=$S(X1>1259:X1-1200,1:X1),X1=$E("000",0,4-$L(X1))_X1_$S(X=2400:"A",X>1159:"P",1:"A")
- ;I "00^15^30^45"'[$E(X1,3,4) Q "" ;NOT NEEDED FOR THIS PROJECT
- S X=$E(X1,1,2)_":"_$E(X1,3,5)
- Q X
- ;
- DNE K X1 Q
- ERR K X,X1 Q
- ;
- CNV(X) ; Convert Start/Stop to minutes AFTER MIDNIGHT RETURN startmin^stopmin
- ;PASS START^STOP
- N CNX,Y
- ; X=start_"^"_stop Output: Y=start(min)_"^"_stop(min)
- S CNX=X,X=$P(CNX,"^",1),Y=0,Y=$$MIL(X,Y),Y=Y\100*60+(Y#100),$P(CNX,"^",1)=Y
- S X=$P(CNX,"^",2),Y=1,Y=$$MIL(X,Y),Y=Y\100*60+(Y#100)
- S Y=$P(CNX,"^",1)_"^"_Y
- Q Y
- ;
- MIL(X,Y) ; Convert from AM/PM to 2400
- ; X=time Y: 0=Mid=0,1=Mid=2400 Output: Y=time in 2400
- I X="MID"!(X="NOON") S Y=$S(X="NOON":1200,Y:2400,1:0) Q Y
- S Y=$P(X,":",1)_$P(X,":",2),Y=+Y Q:X["A" Y
- S:Y<1200 Y=Y+1200
- Q Y
- ;
- DVAL051 ;
- N YSAS
- S YSAS=$$GET^DDSVAL(DIE,.DA,.052)
- Q:YSAS=""
- S YSAS=$$CNV(X_"^"_YSAS)
- Q:$P(YSAS,"^",2)'<$P(YSAS,"^")
- W $C(7)
- S DDSERROR=1
- D HLP^DDSUTL(YSASI1_" * * >> Time Begun cannot be after Time Ended << * *"_YSASI0)
- Q
- ;
- DVAL052 ;
- N YSAS
- S YSAS=$$GET^DDSVAL(DIE,.DA,.051)
- Q:YSAS=""
- S YSAS=$$CNV(YSAS_"^"_X)
- Q:$P(YSAS,"^",2)'<$P(YSAS,"^")
- W $C(7)
- S DDSERROR=1
- D HLP^DDSUTL(YSASI1_" * * >> Time Ended cannot be before Time Begun << * *"_YSASI0)
- Q
- ;
- ;
- HELP ; Time Help
- W !?5,"Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military"
- W !?5,"time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon."
- W !?5,"Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A.",!
- Q
- HLP ;
- N YSAS
- S YSAS(1)="Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military"
- S YSAS(2)="time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon."
- S YSAS(3)="Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A."
- D HLP^DDSUTL(.YSAS)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSAST 2615 printed Feb 18, 2025@23:39:40 Page 2
- YSAST ;ALB/ASF/692/DCL-ASI TIME FUNCTION ;7/30/96 11:20
- +1 ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
- +2 ;CODE TAKEN FROM PRSATIM ROUTINE
- +3 QUIT
- X(X) if $GET(X)=""
- QUIT ""
- +1 NEW X1
- +2 SET X=$TRANSLATE(X,"adimnop","ADIMNOP")
- +3 IF X?1"12".A
- SET X=$SELECT(X="12M":"MID",X="12N":"NOON",1:X)
- +4 IF X?1.A
- SET X=$SELECT(X["MID":2400,X["NOON":1200,1:"")
- +5 if $EXTRACT(X,$LENGTH(X))="M"
- SET X=$EXTRACT(X,1,$LENGTH(X)-1)
- SET X1=$EXTRACT(X,$LENGTH(X))
- IF X1?1U
- IF "AP"'[X1
- QUIT ""
- +6 SET X1=$PIECE(X,":",2)
- IF X1'=""
- IF X1'?2N1.2U
- QUIT ""
- +7 IF X'?4N
- IF $SELECT($LENGTH(+X)<3:+X,1:+X\100)>12
- QUIT ""
- +8 SET X=$PIECE(X,":",1)_$PIECE(X,":",2)
- SET X1=X
- +9 if X?4N
- GOTO A
- IF X'?1.4N1.2U
- QUIT ""
- +10 if X<13
- SET X=X*100
- IF X1["A"
- if X>1259
- QUIT ""
- SET X=$SELECT(X=1200:2400,X>1159:X-1200,1:X)
- +11 IF '$TEST
- IF X<1200
- IF X1["P"!(X<600)
- SET X=X+1200
- IF X<1300
- QUIT ""
- A IF X>2400!('X&(X'="0000"))!(X#100>59)
- QUIT ""
- +1 SET X1=+X
- IF 'X1!(X1=1200)!(X1=2400)
- SET X=$SELECT(X1=1200:"NOON",1:"MID")
- QUIT X
- +2 SET X1=$SELECT(X1>1259:X1-1200,1:X1)
- SET X1=$EXTRACT("000",0,4-$LENGTH(X1))_X1_$SELECT(X=2400:"A",X>1159:"P",1:"A")
- +3 ;I "00^15^30^45"'[$E(X1,3,4) Q "" ;NOT NEEDED FOR THIS PROJECT
- +4 SET X=$EXTRACT(X1,1,2)_":"_$EXTRACT(X1,3,5)
- +5 QUIT X
- +6 ;
- DNE KILL X1
- QUIT
- ERR KILL X,X1
- QUIT
- +1 ;
- CNV(X) ; Convert Start/Stop to minutes AFTER MIDNIGHT RETURN startmin^stopmin
- +1 ;PASS START^STOP
- +2 NEW CNX,Y
- +3 ; X=start_"^"_stop Output: Y=start(min)_"^"_stop(min)
- +4 SET CNX=X
- SET X=$PIECE(CNX,"^",1)
- SET Y=0
- SET Y=$$MIL(X,Y)
- SET Y=Y\100*60+(Y#100)
- SET $PIECE(CNX,"^",1)=Y
- +5 SET X=$PIECE(CNX,"^",2)
- SET Y=1
- SET Y=$$MIL(X,Y)
- SET Y=Y\100*60+(Y#100)
- +6 SET Y=$PIECE(CNX,"^",1)_"^"_Y
- +7 QUIT Y
- +8 ;
- MIL(X,Y) ; Convert from AM/PM to 2400
- +1 ; X=time Y: 0=Mid=0,1=Mid=2400 Output: Y=time in 2400
- +2 IF X="MID"!(X="NOON")
- SET Y=$SELECT(X="NOON":1200,Y:2400,1:0)
- QUIT Y
- +3 SET Y=$PIECE(X,":",1)_$PIECE(X,":",2)
- SET Y=+Y
- if X["A"
- QUIT Y
- +4 if Y<1200
- SET Y=Y+1200
- +5 QUIT Y
- +6 ;
- DVAL051 ;
- +1 NEW YSAS
- +2 SET YSAS=$$GET^DDSVAL(DIE,.DA,.052)
- +3 if YSAS=""
- QUIT
- +4 SET YSAS=$$CNV(X_"^"_YSAS)
- +5 if $PIECE(YSAS,"^",2)'<$PIECE(YSAS,"^")
- QUIT
- +6 WRITE $CHAR(7)
- +7 SET DDSERROR=1
- +8 DO HLP^DDSUTL(YSASI1_" * * >> Time Begun cannot be after Time Ended << * *"_YSASI0)
- +9 QUIT
- +10 ;
- DVAL052 ;
- +1 NEW YSAS
- +2 SET YSAS=$$GET^DDSVAL(DIE,.DA,.051)
- +3 if YSAS=""
- QUIT
- +4 SET YSAS=$$CNV(YSAS_"^"_X)
- +5 if $PIECE(YSAS,"^",2)'<$PIECE(YSAS,"^")
- QUIT
- +6 WRITE $CHAR(7)
- +7 SET DDSERROR=1
- +8 DO HLP^DDSUTL(YSASI1_" * * >> Time Ended cannot be before Time Begun << * *"_YSASI0)
- +9 QUIT
- +10 ;
- +11 ;
- HELP ; Time Help
- +1 WRITE !?5,"Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military"
- +2 WRITE !?5,"time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon."
- +3 WRITE !?5,"Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A.",!
- +4 QUIT
- HLP ;
- +1 NEW YSAS
- +2 SET YSAS(1)="Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military"
- +3 SET YSAS(2)="time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon."
- +4 SET YSAS(3)="Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A."
- +5 DO HLP^DDSUTL(.YSAS)
- +6 QUIT