PRSATIM ;HISC/REL - Time Input Conversion ;01/21/05
;;4.0;PAID;**69,70,71,93,100,126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
S X=$TR(X,"adimnop","ADIMNOP")
S X=$S(X="M":"MID",X="N":"NOON",1:X)
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 G ERR
S X1=$P(X,":",2) I X1'="",X1'?2N1.2U G ERR
I $L(X)>7 G ERR
I X'?4N,$S($L(+X)<3:+X,1:+X\100)>12 G ERR
S X=$P(X,":",1)_$P(X,":",2),X1=X
G:X?4N A I X'?1.4N1.2U G ERR
S:X<13 X=X*100 I X1["A" G:X>1259 ERR 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 G ERR
A I X>2400!('X&(X'="0000"))!(X#100>59) G ERR
S X1=+X I 'X1!(X1=1200)!(X1=2400) S X=$S(X1=1200:"NOON",1:"MID") G DNE
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) G ERR
S X=$E(X1,1,2)_":"_$E(X1,3,5)
DNE K X1 Q
ERR K X,X1 Q
CNV ; Convert Start/Stop to minutes
; X=start_"^"_stop Output: Y=start(min)_"^"_stop(min)
S CNX=X,X=$P(CNX,"^",1),Y=0 D MIL S Y=Y\100*60+(Y#100),$P(CNX,"^",1)=Y
S X=$P(CNX,"^",2),Y=1 D MIL S Y=Y\100*60+(Y#100)
S Y=$P(CNX,"^",1)_"^"_Y K CNX Q
MIL ; 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
S Y=$P(X,":",1)_$P(X,":",2),Y=+Y Q:X["A"
S:Y<1200 Y=Y+1200 Q
HLP ; Time Help
D EN^DDIOL(" Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military")
D EN^DDIOL(" time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon.")
D EN^DDIOL(" Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A."),EN^DDIOL(" ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATIM 1810 printed Jun 11, 2024@22:09:44 Page 2
PRSATIM ;HISC/REL - Time Input Conversion ;01/21/05
+1 ;;4.0;PAID;**69,70,71,93,100,126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET X=$TRANSLATE(X,"adimnop","ADIMNOP")
+4 SET X=$SELECT(X="M":"MID",X="N":"NOON",1:X)
+5 IF X?1"12".A
SET X=$SELECT(X="12M":"MID",X="12N":"NOON",1:X)
+6 IF X?1.A
SET X=$SELECT(X["MID":2400,X["NOON":1200,1:"")
+7 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
GOTO ERR
+8 SET X1=$PIECE(X,":",2)
IF X1'=""
IF X1'?2N1.2U
GOTO ERR
+9 IF $LENGTH(X)>7
GOTO ERR
+10 IF X'?4N
IF $SELECT($LENGTH(+X)<3:+X,1:+X\100)>12
GOTO ERR
+11 SET X=$PIECE(X,":",1)_$PIECE(X,":",2)
SET X1=X
+12 if X?4N
GOTO A
IF X'?1.4N1.2U
GOTO ERR
+13 if X<13
SET X=X*100
IF X1["A"
if X>1259
GOTO ERR
SET X=$SELECT(X=1200:2400,X>1159:X-1200,1:X)
+14 IF '$TEST
IF X<1200
IF X1["P"!(X<600)
SET X=X+1200
IF X<1300
GOTO ERR
A IF X>2400!('X&(X'="0000"))!(X#100>59)
GOTO ERR
+1 SET X1=+X
IF 'X1!(X1=1200)!(X1=2400)
SET X=$SELECT(X1=1200:"NOON",1:"MID")
GOTO DNE
+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 IF "00^15^30^45"'[$EXTRACT(X1,3,4)
GOTO ERR
+4 SET X=$EXTRACT(X1,1,2)_":"_$EXTRACT(X1,3,5)
DNE KILL X1
QUIT
ERR KILL X,X1
QUIT
CNV ; Convert Start/Stop to minutes
+1 ; X=start_"^"_stop Output: Y=start(min)_"^"_stop(min)
+2 SET CNX=X
SET X=$PIECE(CNX,"^",1)
SET Y=0
DO MIL
SET Y=Y\100*60+(Y#100)
SET $PIECE(CNX,"^",1)=Y
+3 SET X=$PIECE(CNX,"^",2)
SET Y=1
DO MIL
SET Y=Y\100*60+(Y#100)
+4 SET Y=$PIECE(CNX,"^",1)_"^"_Y
KILL CNX
QUIT
MIL ; 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
+3 SET Y=$PIECE(X,":",1)_$PIECE(X,":",2)
SET Y=+Y
if X["A"
QUIT
+4 if Y<1200
SET Y=Y+1200
QUIT
HLP ; Time Help
+1 DO EN^DDIOL(" Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military")
+2 DO EN^DDIOL(" time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon.")
+3 DO EN^DDIOL(" Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A.")
DO EN^DDIOL(" ")
+4 QUIT
