- VADATE ;ALB/MLI - GENERIC DATE ROUTINE ; 1 DEC 88 @1000
- ;;5.3;Registration,;**749**;Aug 13, 1993;Build 10
- ;
- I $D(VADAT("F")),$S(VADAT("F")<1:1,VADAT("F")>2:1,1:0) K VADAT("F")
- I '$D(VADAT("W")) S VANOW=$$NOW^XLFDT
- S VA=$S('$D(VADAT("W")):VANOW,1:VADAT("W")),(VA,VADATE("I"))=$S($D(VADAT("S")):VA,'$D(VADAT("T")):$E(VA,1,12),1:$P(VA,".",1))
- S:'$D(VADAT("H")) (VA(1),VA(2),VA(3))=1 I $D(VADAT("H")) F I=1:1:3 S VA(I)=$S(VADAT("H")[I:1,1:0)
- S VAM=$S('$E(VA,4,5):"",'VA(2):"",$S('$D(VADAT("F")):1,VADAT("F")=2:1,1:0):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(VA,4,5)),1:$E(VA,4,5)),VAY=$S(VA(3):(1700+$E(VA,1,3)),1:""),VAD=$S(VA(1)&$E(VA,6,7):$E(VA,6,7),1:"")
- I $P(VA,".",2)]"" S VA=$P(VA,".",2),VAT=$E(VA_"000000",1,2)_":"_$E(VA_"000000",3,4) S:$D(VADAT("S")) VAT=VAT_":"_$E(VA_"000000",5,6)
- I '$D(VADAT("F")) S VADATE("E")=VAM_$S(VAM]""&(VAD!VAY):" ",1:"")_$S(VAD:$J(+VAD,2),1:"")_$S(VAD&VAY:",",1:"")_VAY_$S($D(VAT):"@"_VAT,1:"") G QUIT
- S VADEL=$S('$D(VADAT("D")):"-",1:VADAT("D")) I VADAT("F")=1 S VADATE("E")=$S('VA(2):"",VAM]"":VAM,1:"00")_$S(VA(1)&VA(2):VADEL,1:"")_$S('VA(1):"",VAD]"":VAD,1:"00")_$S((VA(1)!VA(2))&VA(3):VADEL,1:"")
- I VADAT("F")=2 S VADATE("E")=$S('VA(1):"",VAD]"":VAD,1:"00")_$S(VA(1)&VA(2):VADEL,1:"")_$S('VA(2):"",VAM]"":VAM,1:"XXX")_$S((VA(1)!VA(2))&VA(3):VADEL,1:"")
- S VADATE("E")=VADATE("E")_$S(VA(3):$E(VAY,3,4),1:"")_$S($D(VAT):"@"_VAT,1:"")
- QUIT I $D(VADAT("J")),VADAT("J")?.N F I=$L(VADATE("E"))+1:1:VADAT("J") S VADATE("E")=" "_VADATE("E")
- K %DT,VA,VAD,VADEL,VAM,VAT,VAX,VAY,VANOW Q
- KVAR K VADAT,VADATE Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVADATE 1584 printed Jan 18, 2025@04:01:51 Page 2
- VADATE ;ALB/MLI - GENERIC DATE ROUTINE ; 1 DEC 88 @1000
- +1 ;;5.3;Registration,;**749**;Aug 13, 1993;Build 10
- +2 ;
- +3 IF $DATA(VADAT("F"))
- IF $SELECT(VADAT("F")<1:1,VADAT("F")>2:1,1:0)
- KILL VADAT("F")
- +4 IF '$DATA(VADAT("W"))
- SET VANOW=$$NOW^XLFDT
- +5 SET VA=$SELECT('$DATA(VADAT("W")):VANOW,1:VADAT("W"))
- SET (VA,VADATE("I"))=$SELECT($DATA(VADAT("S")):VA,'$DATA(VADAT("T")):$EXTRACT(VA,1,12),1:$PIECE(VA,".",1))
- +6 if '$DATA(VADAT("H"))
- SET (VA(1),VA(2),VA(3))=1
- IF $DATA(VADAT("H"))
- FOR I=1:1:3
- SET VA(I)=$SELECT(VADAT("H")[I:1,1:0)
- +7 SET VAM=$SELECT('$EXTRACT(VA,4,5):"",'VA(2):"",$SELECT('$DATA(VADAT("F")):1,VADAT("F")=2:1,1:0):$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$EXTRACT(VA,4,5)),1:$EXTRACT(VA,4,5))
- SET VAY=$SELECT(VA(3):(1700+$EXTRACT(VA,1,3)),1:"")
- SET VAD=$SELECT(VA(1)&$EXTRACT(VA,6,7):$EXTRACT(VA,6,7),1:"")
- +8 IF $PIECE(VA,".",2)]""
- SET VA=$PIECE(VA,".",2)
- SET VAT=$EXTRACT(VA_"000000",1,2)_":"_$EXTRACT(VA_"000000",3,4)
- if $DATA(VADAT("S"))
- SET VAT=VAT_":"_$EXTRACT(VA_"000000",5,6)
- +9 IF '$DATA(VADAT("F"))
- SET VADATE("E")=VAM_$SELECT(VAM]""&(VAD!VAY):" ",1:"")_$SELECT(VAD:$JUSTIFY(+VAD,2),1:"")_$SELECT(VAD&VAY:",",1:"")_VAY_$SELECT($DATA(VAT):"@"_VAT,1:"")
- GOTO QUIT
- +10 SET VADEL=$SELECT('$DATA(VADAT("D")):"-",1:VADAT("D"))
- IF VADAT("F")=1
- SET VADATE("E")=$SELECT('VA(2):"",VAM]"":VAM,1:"00")_$SELECT(VA(1)&VA(2):VADEL,1:"")_$SELECT('VA(1):"",VAD]"":VAD,1:"00")_$SELECT((VA(1)!VA(2))&VA(3):VADEL,1:"")
- +11 IF VADAT("F")=2
- SET VADATE("E")=$SELECT('VA(1):"",VAD]"":VAD,1:"00")_$SELECT(VA(1)&VA(2):VADEL,1:"")_$SELECT('VA(2):"",VAM]"":VAM,1:"XXX")_$SELECT((VA(1)!VA(2))&VA(3):VADEL,1:"")
- +12 SET VADATE("E")=VADATE("E")_$SELECT(VA(3):$EXTRACT(VAY,3,4),1:"")_$SELECT($DATA(VAT):"@"_VAT,1:"")
- QUIT IF $DATA(VADAT("J"))
- IF VADAT("J")?.N
- FOR I=$LENGTH(VADATE("E"))+1:1:VADAT("J")
- SET VADATE("E")=" "_VADATE("E")
- +1 KILL %DT,VA,VAD,VADEL,VAM,VAT,VAX,VAY,VANOW
- QUIT
- KVAR KILL VADAT,VADATE
- QUIT