Routine: CIAUDT

CIAUDT ;MSC/IND/DKM - FM date to formatted date;04-May-2006 08:19;DKM

 ;;1.2;CIA UTILITIES;;Mar 20, 2007

 ;;Copyright 2000-2006, Medsphere Systems Corporation

 ;=================================================================

 ; Inputs:

 ;   CIADAT = date to format (DHCP format or $H format)

 ;   CIAFMT = date and time format control (optional)

 ;      xxx0 = dd-mmm-yyyy

 ;      xxx1 = mmm dd,yyyy

 ;      xxx2 = mm/dd/yyyy

 ;      xxx3 = mm-dd-yyyy

 ;      xx0x = hh:mm

 ;      xx1x = hh:mm xx

 ;      x0xx = use space to separate date/time

 ;      x1xx = use @ to separate date/time

 ;      0xxx = allow leading zeros

 ;      1xxx = remove leading zeros

 ; Outputs:

 ;   Returns formatted date

 ;=================================================================

ENTRY(CIADAT,CIAFMT) ; EP

 S CIADAT=$G(CIADAT,$H)

 Q:'CIADAT ""

 N CIAZ1,CIAZ2,CIAZ3,CIAZ4,CIADLM,CIATM

 S:CIADAT?1.N1",".N CIADAT=$$HTFM^XLFDT(CIADAT)

 S CIAFMT=$G(CIAFMT)#100000,CIAFMT=CIAFMT#10000,CIAZ4=CIAFMT\1000,CIAFMT=CIAFMT#1000,CIADLM=$S(CIAFMT>99:"@",1:" "),CIAFMT=CIAFMT#100,CIATM=CIAFMT\10,CIAFMT=CIAFMT#10

 I CIADAT\1 D

 .S CIAZ3=CIADAT\1+17000000,CIAZ1=$E(CIAZ3,7,8),CIAZ2=$E(CIAZ3,5,6),CIAZ3=$E(CIAZ3,1,4)

 .S:CIAZ4 CIAZ1=+CIAZ1,CIAZ2=+CIAZ2

 .S:CIAFMT<2 CIAZ2=$P("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec",",",CIAZ2)

 .S CIAZ1=$S('CIAFMT:CIAZ1_"-"_CIAZ2_"-"_CIAZ3,CIAFMT=1:CIAZ2_" "_CIAZ1_","_CIAZ3,CIAFMT=2:CIAZ2_"/"_CIAZ1_"/"_CIAZ3,1:CIAZ2_"-"_CIAZ1_"-"_CIAZ3)

 E  S CIAZ1=""

 S CIAZ2=CIADAT#1*10000+10000\1

 I CIAZ2=10000!(CIAZ2>12400) S CIAZ2=""

 E  D

 .S:CIATM CIAZ2=$S(CIAZ2=12400:CIAZ2-1200_" am",CIAZ2>11299:CIAZ2-1200_" pm",CIAZ2>11199:CIAZ2_" pm",CIAZ2<10099:CIAZ2+1200_" am",1:CIAZ2_" am")

 .S CIAZ3=$S(CIAZ4:+$E(CIAZ2,2,3),1:$E(CIAZ2,2,3)),CIAZ2=CIAZ3_":"_$E(CIAZ2,4,8)

 Q CIAZ1_$S('$L(CIAZ2):"",$L(CIAZ1):CIADLM,1:"")_CIAZ2

CIAUDT    ;MSC/IND/DKM - FM date to formatted date;04-May-2006 08:19;DKM

 +1       ;;1.2;CIA UTILITIES;;Mar 20, 2007

 +2       ;;Copyright 2000-2006, Medsphere Systems Corporation

 +3       ;=================================================================

 +4       ; Inputs:

 +5       ;   CIADAT = date to format (DHCP format or $H format)

 +6       ;   CIAFMT = date and time format control (optional)

 +7       ;      xxx0 = dd-mmm-yyyy

 +8       ;      xxx1 = mmm dd,yyyy

 +9       ;      xxx2 = mm/dd/yyyy

 +10      ;      xxx3 = mm-dd-yyyy

 +11      ;      xx0x = hh:mm

 +12      ;      xx1x = hh:mm xx

 +13      ;      x0xx = use space to separate date/time

 +14      ;      x1xx = use @ to separate date/time

 +15      ;      0xxx = allow leading zeros

 +16      ;      1xxx = remove leading zeros

 +17      ; Outputs:

 +18      ;   Returns formatted date

 +19      ;=================================================================

ENTRY(CIADAT,CIAFMT) ; EP

 +1        SET CIADAT=$GET(CIADAT,$HOROLOG)

 +2        IF 'CIADAT

               QUIT ""

 +3        NEW CIAZ1,CIAZ2,CIAZ3,CIAZ4,CIADLM,CIATM

 +4        IF CIADAT?1.N1",".N

               SET CIADAT=$$HTFM^XLFDT(CIADAT)

 +5        SET CIAFMT=$GET(CIAFMT)#100000

           SET CIAFMT=CIAFMT#10000

           SET CIAZ4=CIAFMT\1000

           SET CIAFMT=CIAFMT#1000

           SET CIADLM=$SELECT(CIAFMT>99:"@",1:" ")

           SET CIAFMT=CIAFMT#100

           SET CIATM=CIAFMT\10

           SET CIAFMT=CIAFMT#10

 +6        IF CIADAT\1

               Begin DoDot:1

 +7                SET CIAZ3=CIADAT\1+17000000

                   SET CIAZ1=$EXTRACT(CIAZ3,7,8)

                   SET CIAZ2=$EXTRACT(CIAZ3,5,6)

                   SET CIAZ3=$EXTRACT(CIAZ3,1,4)

 +8                IF CIAZ4

                       SET CIAZ1=+CIAZ1

                       SET CIAZ2=+CIAZ2

 +9                IF CIAFMT<2

                       SET CIAZ2=$PIECE("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec",",",CIAZ2)

 +10               SET CIAZ1=$SELECT('CIAFMT:CIAZ1_"-"_CIAZ2_"-"_CIAZ3,CIAFMT=1:CIAZ2_" "_CIAZ1_","_CIAZ3,CIAFMT=2:CIAZ2_"/"_CIAZ1_"/"_CIAZ3,1:CIAZ2_"-"_CIAZ1_"-"_CIAZ3)

               End DoDot:1

 +11      IF '$TEST

               SET CIAZ1=""

 +12       SET CIAZ2=CIADAT#1*10000+10000\1

 +13       IF CIAZ2=10000!(CIAZ2>12400)

               SET CIAZ2=""

 +14      IF '$TEST

               Begin DoDot:1

 +15               IF CIATM

                       SET CIAZ2=$SELECT(CIAZ2=12400:CIAZ2-1200_" am",CIAZ2>11299:CIAZ2-1200_" pm",CIAZ2>11199:CIAZ2_" pm",CIAZ2<10099:CIAZ2+1200_" am",1:CIAZ2_" am")

 +16               SET CIAZ3=$SELECT(CIAZ4:+$EXTRACT(CIAZ2,2,3),1:$EXTRACT(CIAZ2,2,3))

                   SET CIAZ2=CIAZ3_":"_$EXTRACT(CIAZ2,4,8)

               End DoDot:1

 +17       QUIT CIAZ1_$SELECT('$LENGTH(CIAZ2):"",$LENGTH(CIAZ1):CIADLM,1:"")_CIAZ2

CIAUDT.m