- PRSPLVU ;WOIFO/SAB - LEAVE UTILITIES ;3/31/2005
- ;;4.0;PAID;**93,126**;Sep 21, 1995;Build 59
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;
- LOADTOD(PPI,PRSIEN,DAY,TOD,TODD) ; Load Tour of Duty into TOD() Array
- ; input
- ; PPI - pay period IEN, file 458
- ; PRSIEN - employee IEN, file 450
- ; DAY - day number in PP
- ; TOD - array, passed by reference, will be initialized
- ; TODD - array, passed by reference, will be initialized
- ; output
- ; TOD - array updated with tour segments in following format
- ; TOD(tour#-segment#)=
- ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
- ; ^special code
- ; TODD - array updated with tour data in the following format
- ; TODD(tour#)=
- ; earliest regular start d/t (FM)^latest regular end d/t (FM)^
- ; tour meal length (minutes)^segment # of longest regular tour segment
- ;
- N FLD,NODE,PRSDT,PRSX,TN,TODI,TODY,TSC,TSE,TSI,TSLS,TSS,TST
- ;
- K TOD,TODD ; initialize array
- ;
- S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
- Q:'PRSDT
- ;
- ; loop thru both tours (#1 and #2) for the day
- F TN=1,2 D
- . S NODE=$S(TN=1:1,TN=2:4,1:"")
- . Q:NODE=""
- . S TODY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,NODE))
- . S TSLS(0)=0 ; init longest regular segment length (seconds)
- . ;
- . ; obtain the tour meal time
- . S FLD=$S(TN=1:2,1:10.3) ; field number corresponding to tour #1 or #2
- . S TODI=$$GET1^DIQ(458.02,DAY_","_PRSIEN_","_PPI_",",FLD,"I") ; tour of duty IEN
- . S:TODI $P(TODD(TN),U,3)=$$GET1^DIQ(457.1,TODI,2) ; tour meal (minutes)
- . ;
- . ; loop thru seven time segments of tour
- . F TSI=1:1:7 D
- . . S TSS=$P(TODY,U,(TSI-1)*3+1) ; time segment start
- . . Q:TSS=""
- . . S TSE=$P(TODY,U,(TSI-1)*3+2) ; time segment end
- . . Q:TSE=""
- . . S TSC=$P(TODY,U,(TSI-1)*3+3) ; time segment special code
- . . ; derive type of time
- . . S TST=$S(TSC:$P($G(^PRST(457.2,TSC,0)),U,2),1:"RG")
- . . ; convert times to FileMan date/time format
- . . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
- . . Q:$P(PRSX,U)=""
- . . S TOD(TN_"-"_TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSC
- . . ;
- . . ; skip remaining steps if segment is not regular time
- . . Q:TST'="RG"
- . . ;
- . . ; if earliest start time of tour is null, set it from current seg.
- . . S:$P($G(TODD(TN)),U)="" $P(TODD(TN),U)=$P(PRSX,U)
- . . ;
- . . ; if latest end time of tour is null, set it from current seg.
- . . S:$P($G(TODD(TN)),U,2)="" $P(TODD(TN),U,2)=$P(PRSX,U,2)
- . . ;
- . . ; if this segments start time is earlier, update the tour start
- . . I $P(PRSX,U)<$P(TODD(TN),U) S $P(TODD(TN),U)=$P(PRSX,U)
- . . ;
- . . ; if this segments end time is later, update the tour end
- . . I $P(PRSX,U,2)>$P(TODD(TN),U,2) S $P(TODD(TN),U,2)=$P(PRSX,U,2)
- . . ;
- . . ; compute length of the tour segment (seconds)
- . . S TSLS=$$FMDIFF^XLFDT($P(PRSX,U,2),$P(PRSX,U,1),2)
- . . ; if segment length more than longest found use it as longest found
- . . I TSLS>TSLS(0) S TSLS(0)=TSLS,$P(TODD(TN),U,4)=TSI
- Q
- ;
- LOADESR(PPI,PRSIEN,DAY,ESR) ; Load ESR into ESR() Array
- ; input
- ; PPI - pay period IEN, file 458
- ; PRSIEN - employee IEN, file 450
- ; DAY - day number in PP
- ; ESR - array, passed by reference, will be initialized
- ; output
- ; ESR - array updated with tour segments in following format
- ; ESR(segment #)=
- ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
- ; ^meal (min)
- ;
- N ESRY,PRSDT,PRSX,TSE,TSI,TSM,TSS,TST
- ;
- K ESR ; initialize array
- ;
- S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
- Q:'PRSDT
- ;
- S ESRY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
- ;
- ; loop thru seven time segments
- F TSI=1:1:7 D
- . S TSS=$P(ESRY,U,(TSI-1)*5+1) ; time segment start
- . Q:TSS=""
- . S TSE=$P(ESRY,U,(TSI-1)*5+2) ; time segment end
- . Q:TSE=""
- . S TST=$P(ESRY,U,(TSI-1)*5+3) ; time segment type of time
- . Q:TST=""
- . ; convert times to FileMan date/time format
- . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
- . Q:$P(PRSX,U)=""
- . S TSM=$P(ESRY,U,(TSI-1)*5+5) ; time segment meal (min)
- . S ESR(TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSM
- Q
- ;
- LOADTC(PPI,PRSIEN,DAY,TC) ; Load Time Card into TC() Array
- ; input
- ; PPI - pay period IEN, file 458
- ; PRSIEN - employee IEN, file 450
- ; DAY - day number in PP
- ; TC - array, passed by reference, may contain data
- ; output
- ; TC - array updated with tour segments in following format
- ; TC(segment #)=
- ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
- ;
- N PRSDT,PRSX,TCY,TSE,TSI,TSS
- ;
- K TC ; initialize array
- ;
- S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
- Q:'PRSDT
- ;
- S TCY=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,2))
- ;
- ; loop thru seven tour segments
- F TSI=1:1:7 D
- . S TSS=$P(TCY,U,(TSI-1)*4+1) ; time segment start
- . Q:TSS=""
- . S TSE=$P(TCY,U,(TSI-1)*4+2) ; time segment end
- . Q:TSE=""
- . S TST=$P(TCY,U,(TSI-1)*4+3) ; time segment type of time
- . Q:TST=""
- . ; convert times to FileMan date/time format
- . S PRSX=$$CNVTS(PRSDT,TSS,TSE)
- . Q:$P(PRSX,U)=""
- . S TC(TSI)=$P(PRSX,U)_U_$P(PRSX,U,2)_U_TST_U_TSS_U_TSE
- Q
- ;
- OKALVR(LVIEN) ; OK Approve Leave Request
- ; Called by Supervisory Approvals to see if it is OK to approve a
- ; leave request
- ; Input
- ; LVIEN - Leave Request IEN (file 458.1)
- ; Result
- ; string value
- ; = 1 if OK to approve leave request
- ; = 0 or 0^PPI if not OK to approve leave request
- ; where PPI is the Pay Period ien (file 458)
- ;
- N D1,DAY,EPP4Y,LVY0,PP4Y,PPE,PPI,PRSIEN,PRSRET,SPP4Y,Y
- ;
- S PRSRET=1 ; initialize as OK
- ;
- I '$G(LVIEN) S PRSRET=0 Q PRSRET ; required input
- ;
- S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
- S PRSIEN=$P(LVY0,U,2) ; employee IEN
- ;
- ; if employee has any memos
- I $$PTP^PRSPUT3(PRSIEN) D
- . ; determine starting and ending pay periods
- . S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
- . S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
- . ;
- . ; loop thru pay periods
- . S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
- . F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D Q:'PRSRET
- . . S PPI=$O(^PRST(458,"AB",PP4Y,0))
- . . ;
- . . ; skip PP if not covered by memo
- . . S D1=$P($G(^PRST(458,PPI,1)),U)
- . . Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0 ; PP not covered by memo
- . . ;
- . . ; skip PP if time card status not = payroll
- . . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="P"
- . . ;
- . . ; can't approve this leave request until time card status changes
- . . S PRSRET=0_U_PPI
- ;
- Q PRSRET
- ;
- CNVTS(DATE,START,END) ; Convert Time Segment
- ; input
- ; returns string with value =
- ; Start Date/Time (FileMan internal)^End Date/Time (FileMan internal)
- ;
- N CNX,FMEND,FMSTR,PRSM,PRSRET,X,XMID,Y
- S X=START_U_END
- D CNV^PRSATIM
- S PRSM=Y
- S XMID=$S($P(PRSM,U,2)'>$P(PRSM,U):1,1:0)
- S FMSTR=$$FMADD^XLFDT(DATE,,,$P(PRSM,U))
- S FMEND=$$FMADD^XLFDT(DATE,XMID,,$P(PRSM,U,2))
- S PRSRET=FMSTR_"^"_FMEND
- ;
- Q PRSRET
- ;
- FMETA(TIME) ; FileMan to ETA time
- N HRS,MIN,PM,PRSRET
- S PRSRET=""
- S TIME=$$LJ^XLFSTR(TIME,4,"0") ; add trailing 0s to fileman time
- I TIME=1200 S PRSRET="NOON"
- I TIME=2400 S PRSRET="MID"
- I PRSRET="" D
- . S PM=0
- . S HRS=$E(TIME,1,2)
- . S MIN=$E(TIME,3,4)
- . I HRS>12 S HRS=HRS-12,PM=1
- . S PRSRET=$$RJ^XLFSTR(HRS,2,"0")_":"_$$RJ^XLFSTR(MIN,2,"0")_$S(PM:"P",1:"A")
- Q PRSRET
- ;PRSPLVU
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPLVU 7556 printed Jan 18, 2025@03:29:20 Page 2
- PRSPLVU ;WOIFO/SAB - LEAVE UTILITIES ;3/31/2005
- +1 ;;4.0;PAID;**93,126**;Sep 21, 1995;Build 59
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;
- LOADTOD(PPI,PRSIEN,DAY,TOD,TODD) ; Load Tour of Duty into TOD() Array
- +1 ; input
- +2 ; PPI - pay period IEN, file 458
- +3 ; PRSIEN - employee IEN, file 450
- +4 ; DAY - day number in PP
- +5 ; TOD - array, passed by reference, will be initialized
- +6 ; TODD - array, passed by reference, will be initialized
- +7 ; output
- +8 ; TOD - array updated with tour segments in following format
- +9 ; TOD(tour#-segment#)=
- +10 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
- +11 ; ^special code
- +12 ; TODD - array updated with tour data in the following format
- +13 ; TODD(tour#)=
- +14 ; earliest regular start d/t (FM)^latest regular end d/t (FM)^
- +15 ; tour meal length (minutes)^segment # of longest regular tour segment
- +16 ;
- +17 NEW FLD,NODE,PRSDT,PRSX,TN,TODI,TODY,TSC,TSE,TSI,TSLS,TSS,TST
- +18 ;
- +19 ; initialize array
- KILL TOD,TODD
- +20 ;
- +21 SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
- +22 if 'PRSDT
- QUIT
- +23 ;
- +24 ; loop thru both tours (#1 and #2) for the day
- +25 FOR TN=1,2
- Begin DoDot:1
- +26 SET NODE=$SELECT(TN=1:1,TN=2:4,1:"")
- +27 if NODE=""
- QUIT
- +28 SET TODY=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,NODE))
- +29 ; init longest regular segment length (seconds)
- SET TSLS(0)=0
- +30 ;
- +31 ; obtain the tour meal time
- +32 ; field number corresponding to tour #1 or #2
- SET FLD=$SELECT(TN=1:2,1:10.3)
- +33 ; tour of duty IEN
- SET TODI=$$GET1^DIQ(458.02,DAY_","_PRSIEN_","_PPI_",",FLD,"I")
- +34 ; tour meal (minutes)
- if TODI
- SET $PIECE(TODD(TN),U,3)=$$GET1^DIQ(457.1,TODI,2)
- +35 ;
- +36 ; loop thru seven time segments of tour
- +37 FOR TSI=1:1:7
- Begin DoDot:2
- +38 ; time segment start
- SET TSS=$PIECE(TODY,U,(TSI-1)*3+1)
- +39 if TSS=""
- QUIT
- +40 ; time segment end
- SET TSE=$PIECE(TODY,U,(TSI-1)*3+2)
- +41 if TSE=""
- QUIT
- +42 ; time segment special code
- SET TSC=$PIECE(TODY,U,(TSI-1)*3+3)
- +43 ; derive type of time
- +44 SET TST=$SELECT(TSC:$PIECE($GET(^PRST(457.2,TSC,0)),U,2),1:"RG")
- +45 ; convert times to FileMan date/time format
- +46 SET PRSX=$$CNVTS(PRSDT,TSS,TSE)
- +47 if $PIECE(PRSX,U)=""
- QUIT
- +48 SET TOD(TN_"-"_TSI)=$PIECE(PRSX,U)_U_$PIECE(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSC
- +49 ;
- +50 ; skip remaining steps if segment is not regular time
- +51 if TST'="RG"
- QUIT
- +52 ;
- +53 ; if earliest start time of tour is null, set it from current seg.
- +54 if $PIECE($GET(TODD(TN)),U)=""
- SET $PIECE(TODD(TN),U)=$PIECE(PRSX,U)
- +55 ;
- +56 ; if latest end time of tour is null, set it from current seg.
- +57 if $PIECE($GET(TODD(TN)),U,2)=""
- SET $PIECE(TODD(TN),U,2)=$PIECE(PRSX,U,2)
- +58 ;
- +59 ; if this segments start time is earlier, update the tour start
- +60 IF $PIECE(PRSX,U)<$PIECE(TODD(TN),U)
- SET $PIECE(TODD(TN),U)=$PIECE(PRSX,U)
- +61 ;
- +62 ; if this segments end time is later, update the tour end
- +63 IF $PIECE(PRSX,U,2)>$PIECE(TODD(TN),U,2)
- SET $PIECE(TODD(TN),U,2)=$PIECE(PRSX,U,2)
- +64 ;
- +65 ; compute length of the tour segment (seconds)
- +66 SET TSLS=$$FMDIFF^XLFDT($PIECE(PRSX,U,2),$PIECE(PRSX,U,1),2)
- +67 ; if segment length more than longest found use it as longest found
- +68 IF TSLS>TSLS(0)
- SET TSLS(0)=TSLS
- SET $PIECE(TODD(TN),U,4)=TSI
- End DoDot:2
- End DoDot:1
- +69 QUIT
- +70 ;
- LOADESR(PPI,PRSIEN,DAY,ESR) ; Load ESR into ESR() Array
- +1 ; input
- +2 ; PPI - pay period IEN, file 458
- +3 ; PRSIEN - employee IEN, file 450
- +4 ; DAY - day number in PP
- +5 ; ESR - array, passed by reference, will be initialized
- +6 ; output
- +7 ; ESR - array updated with tour segments in following format
- +8 ; ESR(segment #)=
- +9 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
- +10 ; ^meal (min)
- +11 ;
- +12 NEW ESRY,PRSDT,PRSX,TSE,TSI,TSM,TSS,TST
- +13 ;
- +14 ; initialize array
- KILL ESR
- +15 ;
- +16 SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
- +17 if 'PRSDT
- QUIT
- +18 ;
- +19 SET ESRY=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
- +20 ;
- +21 ; loop thru seven time segments
- +22 FOR TSI=1:1:7
- Begin DoDot:1
- +23 ; time segment start
- SET TSS=$PIECE(ESRY,U,(TSI-1)*5+1)
- +24 if TSS=""
- QUIT
- +25 ; time segment end
- SET TSE=$PIECE(ESRY,U,(TSI-1)*5+2)
- +26 if TSE=""
- QUIT
- +27 ; time segment type of time
- SET TST=$PIECE(ESRY,U,(TSI-1)*5+3)
- +28 if TST=""
- QUIT
- +29 ; convert times to FileMan date/time format
- +30 SET PRSX=$$CNVTS(PRSDT,TSS,TSE)
- +31 if $PIECE(PRSX,U)=""
- QUIT
- +32 ; time segment meal (min)
- SET TSM=$PIECE(ESRY,U,(TSI-1)*5+5)
- +33 SET ESR(TSI)=$PIECE(PRSX,U)_U_$PIECE(PRSX,U,2)_U_TST_U_TSS_U_TSE_U_TSM
- End DoDot:1
- +34 QUIT
- +35 ;
- LOADTC(PPI,PRSIEN,DAY,TC) ; Load Time Card into TC() Array
- +1 ; input
- +2 ; PPI - pay period IEN, file 458
- +3 ; PRSIEN - employee IEN, file 450
- +4 ; DAY - day number in PP
- +5 ; TC - array, passed by reference, may contain data
- +6 ; output
- +7 ; TC - array updated with tour segments in following format
- +8 ; TC(segment #)=
- +9 ; start d/t (FM)^end d/t (FM)^type of time^start time(ETA)^end time(ETA)
- +10 ;
- +11 NEW PRSDT,PRSX,TCY,TSE,TSI,TSS
- +12 ;
- +13 ; initialize array
- KILL TC
- +14 ;
- +15 SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
- +16 if 'PRSDT
- QUIT
- +17 ;
- +18 SET TCY=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,2))
- +19 ;
- +20 ; loop thru seven tour segments
- +21 FOR TSI=1:1:7
- Begin DoDot:1
- +22 ; time segment start
- SET TSS=$PIECE(TCY,U,(TSI-1)*4+1)
- +23 if TSS=""
- QUIT
- +24 ; time segment end
- SET TSE=$PIECE(TCY,U,(TSI-1)*4+2)
- +25 if TSE=""
- QUIT
- +26 ; time segment type of time
- SET TST=$PIECE(TCY,U,(TSI-1)*4+3)
- +27 if TST=""
- QUIT
- +28 ; convert times to FileMan date/time format
- +29 SET PRSX=$$CNVTS(PRSDT,TSS,TSE)
- +30 if $PIECE(PRSX,U)=""
- QUIT
- +31 SET TC(TSI)=$PIECE(PRSX,U)_U_$PIECE(PRSX,U,2)_U_TST_U_TSS_U_TSE
- End DoDot:1
- +32 QUIT
- +33 ;
- OKALVR(LVIEN) ; OK Approve Leave Request
- +1 ; Called by Supervisory Approvals to see if it is OK to approve a
- +2 ; leave request
- +3 ; Input
- +4 ; LVIEN - Leave Request IEN (file 458.1)
- +5 ; Result
- +6 ; string value
- +7 ; = 1 if OK to approve leave request
- +8 ; = 0 or 0^PPI if not OK to approve leave request
- +9 ; where PPI is the Pay Period ien (file 458)
- +10 ;
- +11 NEW D1,DAY,EPP4Y,LVY0,PP4Y,PPE,PPI,PRSIEN,PRSRET,SPP4Y,Y
- +12 ;
- +13 ; initialize as OK
- SET PRSRET=1
- +14 ;
- +15 ; required input
- IF '$GET(LVIEN)
- SET PRSRET=0
- QUIT PRSRET
- +16 ;
- +17 ; leave request 0 node
- SET LVY0=$GET(^PRST(458.1,LVIEN,0))
- +18 ; employee IEN
- SET PRSIEN=$PIECE(LVY0,U,2)
- +19 ;
- +20 ; if employee has any memos
- +21 IF $$PTP^PRSPUT3(PRSIEN)
- Begin DoDot:1
- +22 ; determine starting and ending pay periods
- +23 ; based on leave from -1 (use -1 in case of 2-day tour)
- SET D1=$$FMADD^XLFDT($PIECE(LVY0,U,3),-1)
- DO PP^PRSAPPU
- SET SPP4Y=PP4Y
- +24 ; based on leave to
- SET D1=$PIECE(LVY0,U,5)
- DO PP^PRSAPPU
- SET EPP4Y=PP4Y
- +25 ;
- +26 ; loop thru pay periods
- +27 ; set initial value to previous PP
- SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
- +28 FOR
- SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
- if PP4Y=""!(PP4Y]EPP4Y)
- QUIT
- Begin DoDot:2
- +29 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
- +30 ;
- +31 ; skip PP if not covered by memo
- +32 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
- +33 ; PP not covered by memo
- if $$MIEN^PRSPUT1(PRSIEN,D1)'>0
- QUIT
- +34 ;
- +35 ; skip PP if time card status not = payroll
- +36 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="P"
- QUIT
- +37 ;
- +38 ; can't approve this leave request until time card status changes
- +39 SET PRSRET=0_U_PPI
- End DoDot:2
- if 'PRSRET
- QUIT
- End DoDot:1
- +40 ;
- +41 QUIT PRSRET
- +42 ;
- CNVTS(DATE,START,END) ; Convert Time Segment
- +1 ; input
- +2 ; returns string with value =
- +3 ; Start Date/Time (FileMan internal)^End Date/Time (FileMan internal)
- +4 ;
- +5 NEW CNX,FMEND,FMSTR,PRSM,PRSRET,X,XMID,Y
- +6 SET X=START_U_END
- +7 DO CNV^PRSATIM
- +8 SET PRSM=Y
- +9 SET XMID=$SELECT($PIECE(PRSM,U,2)'>$PIECE(PRSM,U):1,1:0)
- +10 SET FMSTR=$$FMADD^XLFDT(DATE,,,$PIECE(PRSM,U))
- +11 SET FMEND=$$FMADD^XLFDT(DATE,XMID,,$PIECE(PRSM,U,2))
- +12 SET PRSRET=FMSTR_"^"_FMEND
- +13 ;
- +14 QUIT PRSRET
- +15 ;
- FMETA(TIME) ; FileMan to ETA time
- +1 NEW HRS,MIN,PM,PRSRET
- +2 SET PRSRET=""
- +3 ; add trailing 0s to fileman time
- SET TIME=$$LJ^XLFSTR(TIME,4,"0")
- +4 IF TIME=1200
- SET PRSRET="NOON"
- +5 IF TIME=2400
- SET PRSRET="MID"
- +6 IF PRSRET=""
- Begin DoDot:1
- +7 SET PM=0
- +8 SET HRS=$EXTRACT(TIME,1,2)
- +9 SET MIN=$EXTRACT(TIME,3,4)
- +10 IF HRS>12
- SET HRS=HRS-12
- SET PM=1
- +11 SET PRSRET=$$RJ^XLFSTR(HRS,2,"0")_":"_$$RJ^XLFSTR(MIN,2,"0")_$SELECT(PM:"P",1:"A")
- End DoDot:1
- +12 QUIT PRSRET
- +13 ;PRSPLVU