PRSNRMM ;WOIFO-JAH - POC Record and Timecard Mismatches;07/31/09
;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
;;Per VHA Directive 6402, this routine should not be modified.
Q
;
PPMM(PRSIEN,PPI,PG,STOP) ; report mismatches for a pay period
N PRSD,MM
S STOP=+$G(STOP)
S PG=+$G(PG)
D HDR(.STOP,1,PRSIEN,PPI,.PG)
F PRSD=1:1:14 Q:STOP D
. K MM
. D DAILYMM(.MM,PRSIEN,PPI,PRSD)
. Q:MM(0)'>0
. W !!,$P($G(^PRST(458,PPI,2)),U,PRSD)
. D DISPMM(.MM,.STOP,1,PRSIEN,PPI,PRSD)
. I (IOSL-4)<$Y D HDR(.STOP,1,PRSIEN,PPI,.PG)
Q
DISPMM(MM,STOP,HDR,PRSIEN,PPI,PRSD) ; Display a single day of mismatches between
; a timecard and a POC record
; INPUT:
; MM-(array by reference) call DAILYMM to get an array of
; mismatches to pass to this display routine
; PPI-(required) pay period IEN
; PRSD-(required) day number in pay period referenced in PPI
; HDR-(optional) set to true if you want a header included
;
; OUTPUT:
; STOP-reference variable returned as true if the user was
; prompted to continue and responded with an '^' to quit
;
N T1,T2,TT,P1,P2,PT,PTE,TTE,MISM,DASH
I $G(STOP)'>0 S STOP=0
I $G(HDR)'>0 S HDR=0
S DASH=" -"
S J=0
F S J=$O(MM(J)) Q:J'>0!STOP D
. I (IOSL-4)<$Y D HDR(.STOP,HDR,PRSIEN,PPI,.PG)
. Q:STOP
. S MISM=$G(MM(J))
. S T1=$$ETIM($P(MISM,U))
. S T2=$$ETIM($P(MISM,U,2))
. S TT=$P(MISM,U,3)
. S TTE=$P(MISM,U,4)
. S P1=$$ETIM($P(MISM,U,5))
. S P2=$$ETIM($P(MISM,U,6))
. S PT=$P(MISM,U,7)
. S PTE=$P(MISM,U,8)
. W !,$J(T1,7),DASH,$J(T2,7),?19,TT,?24,TTE,?40,$J(P1,7),DASH,$J(P2,7),?60,PT,?64,PTE
Q
HDR(STOP,HDR,PRSIEN,PPI,PG) ;
I PG>0 S STOP=$$ASK^PRSLIB00()
Q:STOP
W @IOF,! S PG=PG+1
I HDR D
. N PPE,PPBEG,PPEND,TITLE,TITLE2,PGE,RUNDATE
. S PPE=$P($G(^PRST(458,PPI,0)),U)
. S PPBEG=$P($G(^PRST(458,PPI,2)),U,1)
. S PPEND=$P($G(^PRST(458,PPI,2)),U,14)
. S TITLE="Mismatch Report Between ETA Timecard & Point of Care Record"
. S TITLE2="for Pay Period "_PPE_" ("_PPBEG_" - "_PPEND_")"
. W ?((IOM-$L(TITLE))\2),TITLE
. W !,?((IOM-$L(TITLE2))\2),TITLE2
. S PGE="Page "_PG
. I PG>0 W ?(IOM-$L(PGE)-2),PGE
. S RUNDATE="Run Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
. W !,?3,"Nurse: ",$P($G(^PRSPC(PRSIEN,0)),U)
. W ?(IOM-$L(RUNDATE)-3),RUNDATE
. W !!,?9,"ETA TIMECARD",?46,"POINT OF CARE RECORD"
. W !,?2,"=================================",?40,"==================================="
Q
DAILYMM(MM,PRSIEN,PPI,PRSD) ;
; INPUT:
; PRSIEN: 450/451 IEN
; PPI: 451/458 Pay Period IEN
; PRSD: day 1-14 of pay period
; OUTPUT:
; MM - mismatch array index 1..n for each mismatch
; MM(0) = number of mismatches and zero for none
; MM(0+n) = TC Seg start^TC Seg Stop^TT^POC seg start^POC seg stop^TT
;
;Loop through Timecard storing types of time in TD string and TD array
;
N ND,TD
S MM(0)=0
D BLDTC(.TD,PRSIEN,PPI,PRSD,0)
;
; Loop through POC Record storing time in ND string and ND array
;
D BLDPOC(.ND,PRSIEN,PPI,PRSD,0)
I '$D(ND) S MM="-1^NO POC RECORD" Q
;
; Strings will look like
;
; TD="00000000000000000AAAAAAAAAAAAAAAAAA000000000000000000000..."
; ND="00000000000000000AAAAAAAAAAAAAAAAAAWWWWWWWWWWWWWWWWWWW00..."
;
;
; arrays will look like:
;
; TD(0)=code^segment start^segment stop^ETA TT
; TD(1)=code^segment start^segment stop^ETA TT
; TD(3)=code^segment start^segment stop^ETA TT
; TD(4)=code^segment start^segment stop^ETA TT
; .....
; TD(188)=code^segment start^segment stop^ETA TT
; TD(189)=code^segment start^segment stop^ETA TT
; TD(190)=code^segment start^segment stop^ETA TT
;
; ND(0)=code^segment start^segment stop^POC TT
; ND(1)=code^segment start^segment stop^POC TT
; .....
; ND(191)=code^segment start^segment stop^POC TT
; ND(192)=code^segment start^segment stop^POC TT
;
; If strings match there are no mismatches and we are done.
;
I ND=TD Q
;
; traverse strings until first mismatched characters are found.
; Once a mismatch is found determine the segments associated with
; each of the corresponding characters that mismatch.
; This can easily be found because the ND and TD arrays have
; stored the start and stop of each segment in the node where
; corresponding to the position in the ND and TD strings.
;
N TCBEG,TCEND,TCBEGI,TCENDI,POCTT,POCBEGI,POCENDI,POCBEG,POCEND
N I,POCTT,POCTTE,TCTT,TCTTE
F I=1:1:192 I $E(ND,I)'=$E(TD,I) D
. S MM(0)=MM(0)+1
. S TCTT=$P(TD(I),U,5)
. S TCTTE=$$TTE^PRSPSAPU(TCTT)
. I $P(TD(I),U,2)="Z" S TCTT="",TCTTE="Unposted Tour"
. S TCBEGI=+$P(TD(I),U,3)
. S TCENDI=+$P(TD(I),U,4)
. S POCTT=$P(ND(I),U,5)
. S POCTTE=$$TTE^PRSPSAPU(POCTT)
. S POCBEGI=+$P(ND(I),U,3)
. S POCENDI=+$P(ND(I),U,4)
. S TCBEG=+$G(TD(TCBEGI))
. S TCEND=+$G(TD(TCENDI+1))
. S POCBEG=+$G(ND(POCBEGI))
. S POCEND=+$G(ND(POCENDI+1))
.; Adjust end points of segment for clearer reporting when
.; POC or ETA has no data at the point of mismatch
. I $E(TD,I)=0 D
.. I TCENDI>POCENDI S TCEND=+$G(ND(POCENDI+1))
.. I TCBEGI<POCBEGI S TCBEG=+$G(ND(POCBEGI))
.. S TCTTE="No Data"
. I $E(ND,I)=0 D
.. I POCENDI>TCENDI S POCEND=+$G(TD(TCENDI+1))
.. I POCBEGI<TCBEGI S POCBEG=+$G(TD(TCBEGI))
.. S POCTTE="No Data"
. S MM(+MM(0))=TCBEG_U_TCEND_U_TCTT_U_TCTTE_U_POCBEG_U_POCEND_U_POCTT_U_POCTTE
.; start the search back up at the end of the shorter segment
.; unless there is no time in the shorter segment
. I POCENDI=0 S I=TCENDI Q
. I TCENDI=0 S I=POCENDI Q
. I POCENDI>TCENDI D
.. S I=TCENDI
. E D
.. S I=POCENDI
Q
BLDPOC(ND,PRSIEN,PPI,PRSD,ACTIVITY) ; Build string and array from POC day
; initialize ND
; INPUT:
; PRSIEN: 450 IEN
; PPI: 458/451 IEN
; PRSD: Pay period day number 1-14
; ACTIVITY: flag set to true if you want to have only portions
; of the array with activity to be returned.
; ND: activity string and array
;
N I,POCD,J,CC,SET,T1,T2,TT,SEG
F I=1:1:192 S $E(ND,I)=0
F I=1:1:193 S ND(I)=+$$POSTIM(I,1)
D L1^PRSNRUT1(.POCD,PPI,PRSIEN,PRSD)
S SEG=0
F S SEG=$O(POCD(SEG)) Q:SEG'>0 D
. S T1=$$TIMEPOS($P(POCD(SEG),U,9),1)
. S T2=$$TIMEPOS($P(POCD(SEG),U,10),0)
. S TT=$P(POCD(SEG),U,4)
. S CC=$$CONVERT(TT)
. F J=T1:1:T2 Q:J>192 S $P(ND(J),U,2,5)=CC_U_T1_U_T2_U_TT,$E(ND,J)=CC
; loop through activity again to update all the start and stop
; times for each segment, this will give segment start and stops
; to periods where there is no data
;
N LQH,NEWSTART,QH,NEWEND
S LQH=0,NEWSTART=1
F I=1:1:192 D
. S QH=$E(ND,I)
. I LQH'=QH S NEWSTART=I,LQH=QH
. S $P(ND(I),U,3)=NEWSTART
;
S LQH=0,NEWEND=192
F I=192:-1:1 D
. S QH=$E(ND,I)
. I LQH'=QH S NEWEND=I,LQH=QH
. S $P(ND(I),U,4)=NEWEND
;
;
; If activity is true remove all nodes with no activity
;
I ACTIVITY D
. F I=1:1:193 I $P($G(ND(I)),U,2)="" K ND(I)
. S ND=0
;
Q
BLDTC(TD,PRSIEN,PPI,PRSD,ACTIVITY) ; Build string and array from Time Card day
; initialize TD
; INPUT: standard PRSIEN, PPI, PRSD
; ACTIVITY-(optional) flag set to true if return array
; should only contain nodes with activity
; OUTPUT:
; TD (string) with 192 characters representing each 15 minutes of
; the day
; if ACTIVITY parameter true then TD string will be set as follows:
; TD = timecard posting status ^ tour of duty IEN
;
; TD(1..192)--array with nodes of activity for each 15 min.
;
N I,J,CC,SET,TS,TE,TOUR,T1,T2,TT,TC,TOD,TODD,TCD,X,Y,POSTED,DAYOFF,SEG,NEWSTART,NEWEND,LQH,POC,QH
F I=1:1:193 S TD(I)=+$$POSTIM(I,1)
D LOADTOD^PRSPLVU(PPI,PRSIEN,PRSD,.TOD,.TODD)
D LOADTC^PRSPLVU(PPI,PRSIEN,PRSD,.TCD)
;
; Check for no time posted on the timecard
N X0,PSTAT
S X0=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
;
; posting status--(T)imekeeper, (P)ayroll, (X)mitted
S PSTAT=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,1)
;
; tour of duty (1=day off, 3,4=intermittent)
S TC=$P(X0,U,2)
S POSTED=1
I "1 3 4"'[TC,PSTAT="" S (PSTAT,POSTED)=0 ; - no posting to tour
;
F I=1:1:192 S $E(TD,I)=0
;
S SEG=0
F S SEG=$O(TOD(SEG)) Q:SEG'>0 D
. S TT=$P(TOD(SEG),U,3)
. I TT="RG" S TT="WI"
. S CC=$$CONVERT(TT)
. S POC=$$CNVTTPOC(TT)
. I 'POSTED S CC="Z"
. S T1=$P(TOD(SEG),U,4)
. S X=T1,Y=0 D MIL^PRSATIM S T1=Y
. S T2=$P(TOD(SEG),U,5)
. S X=T2,Y=1 D MIL^PRSATIM S T2=Y
. ; if the start time is earlier than the stop time then it
. ; must be a time on a second day of a two day tour
. I T1>T2 S T2=T2+2400
. S TOUR(T1)=T2
. S T1=$$TIMEPOS(T1,1)
. S T2=$$TIMEPOS(T2,0)
. F J=T1:1:T2 Q:J>192 S $P(TD(J),U,2,6)=CC_U_T1_U_T2_U_TT_U_POC,$E(TD,J)=CC
;
; place posted exceptions
;
S SEG=0
F S SEG=$O(TCD(SEG)) Q:SEG'>0 D
. S TT=$P(TCD(SEG),U,3)
. S T1=$P(TCD(SEG),U,4)
. S X=T1,Y=0 D MIL^PRSATIM S T1=Y
. S T2=$P(TCD(SEG),U,5)
. S X=T2,Y=1 D MIL^PRSATIM S T2=Y
. ; try to place exceptions on the correct day
. S T1=$$PLACEX(T1,T2,.TOUR)
. ; if the start time is earlier than the stop time then it
. ; must be a time on a second day of a two day tour
. I T1>T2 S T2=T2+2400
. S T1=$$TIMEPOS(T1,1)
. S T2=$$TIMEPOS(T2,0)
. S CC=$$CONVERT(TT)
. S POC=$$CNVTTPOC(TT)
. F J=T1:1:T2 Q:J>192 S $P(TD(J),U,2,6)=CC_U_T1_U_T2_U_TT_U_POC,$E(TD,J)=CC
;
; place meal
;TODD(1)="3090917^3090918.08^30^2"
N LEN,LONGSEG,MEAL,EN,STPOS,ENPOS,MIDPOS,MLOC,ST
I +$P($G(TODD(1)),U,3)>0 D
.S MEAL=0
.F S MEAL=$O(TODD(MEAL)) Q:MEAL'>0 D
.. S LEN=$P(TODD(MEAL),U,3)
.. ; Patch PRS*4.0*142 adds a QUIT condition in the event that LONGSEG equals null.
.. S LONGSEG=$P(TODD(MEAL),U,4) I 'LONGSEG Q
..;;;;;; start of longest tour segment
.. S ST=$P(TOD(MEAL_"-"_LONGSEG),U,4)
.. S X=ST,Y=0 D MIL^PRSATIM S ST=Y
..;;;;;; end of longest tour segment
.. S EN=$P(TOD(MEAL_"-"_LONGSEG),U,5)
.. S X=EN,Y=1 D MIL^PRSATIM S EN=Y
..;
.. I ST>EN S EN=EN+2400
..;;;;;;
.. S STPOS=$$TIMEPOS(ST,1)
.. S ENPOS=$$TIMEPOS(EN,0)
.. S MIDPOS=STPOS+((ENPOS-STPOS)\2)
..;;;;;;; get starting location of the segment where this midway falls
.. S MLOC=$P(TD(MIDPOS),U,3)
.. S $P(TD(MLOC),U,7)=LEN
; loop through activity again to update all the start and stop
; times for each segment, since exceptions that overwrote the tour
; will change the start and stops for subsections of tour
;
S LQH=0,NEWSTART=1
F I=1:1:192 D
. S QH=$E(TD,I)
. I LQH'=QH S NEWSTART=I,LQH=QH
. S $P(TD(I),U,3)=NEWSTART
;
S LQH=0,NEWEND=192
F I=192:-1:1 D
. S QH=$E(TD,I)
. I LQH'=QH S NEWEND=I,LQH=QH
. S $P(TD(I),U,4)=NEWEND
;
; If activity is true remove all nodes with no activity
;
I ACTIVITY D
. F I=1:1:193 I $P($G(TD(I)),U,2)="" K TD(I)
. S TD=PSTAT_U_TC
;
Q
;
PLACEX(T1,T2,TOUR) ;
;
N TS,TE,NEWT1,TEMPT1
;need to make two passes on the tour array as there may be more than one tour
;and need to make sure that the exception doesn't fit within any tour before adjusting
S NEWT1=""
S TS=""
F S TS=$O(TOUR(TS)) Q:TS="" D Q:NEWT1'=""
. S TE=TOUR(TS)
. I T1'<TS D Q:NEWT1'=""
.. ; this time segment falls within the tour, so fits
.. I T1'>TE S NEWT1=T1 Q
.. ; this time segment starts no more than 4 hours after tour, then probably fits
.. I $$TIMEDIF(TE,T1)'>240 S NEWT1=T1 Q
. I T1<TS D Q:NEWT1'=""
.. ; this time segment starts no more than 4 hours before tour, then probably fits
.. I $$TIMEDIF(T1,TS)'>240 S NEWT1=T1 Q
;
I NEWT1'="" Q NEWT1
;
; looks like we have a segment that should be starting in day two
; but need to see if that fits
S TEMPT1=T1+2400
S TS=""
F S TS=$O(TOUR(TS)) Q:TS="" D Q:NEWT1'=""
. S TE=TOUR(TS)
. I TEMPT1'<TS D Q:NEWT1'=""
.. ; this time segment falls within the tour, so fits
.. I TEMPT1'>TE S NEWT1=TEMPT1 Q
.. ; this time segment starts no more than 4 hours after tour, then probably fits
.. I $$TIMEDIF(TE,TEMPT1)'>240 S NEWT1=TEMPT1 Q
;
;if we didn't find it earlier, then just leave it as the originally entered time
;and if that is wrong, user will need to adjust it
I NEWT1="" S NEWT1=T1
;
Q NEWT1
;
TIMEDIF(TIME1,TIME2) ;
;
;SUBTRACT TIME1 FROM TIME2
;RETURN TIME DIFFERENCE IN MINUTES
N HOUR,MIN,DIFF,MIN1,MIN2
S MIN=TIME1#100,HOUR=TIME1\100,MIN1=HOUR*60+MIN
S MIN=TIME2#100,HOUR=TIME2\100,MIN2=HOUR*60+MIN
S DIFF=MIN2-MIN1
Q DIFF
;
CNVTTPOC(TT) ; convert an ETA type of time to POC time
N TC,POC,CODEPOS
S POC="AA^AA^AD^AL^CB^CU^DL^RL^RS^HX^ML^SL^WP^NL^NP^WI^TR^TV^WO^WO^WO^WO^HW^^^^"
S TC="AA^CP^AD^AL^CB^CU^DL^RL^RS^HX^ML^SL^WP^NL^NP^WI^TR^TV^WO^OT^CT^RG^HW^UN^ON^SB^"
S CODEPOS=$FIND(TC,TT)
Q $P(POC,U,CODEPOS/3)
;
CONVERT(TT) ; Convert a type of time code to a comparison code
; COMPARISON
; ETA POC STRINGS
; CODE ETA DX CODE POC DX CODE
; ==== =============== ===== =========== =====
; AA Auth Abs AA Auth Abs A
; CP Cont of Pay AA Auth Abs A
; AD Adoption AD Adoption D
; AL Annual Leave AL Annual Leave L
; CB Fam Care Bereav CB Fam Care Bereav B
; CU Comp/Cred Used CU Comp/Cred Used U
; DL Donor Leave DL Donor Leave d
; RL Restored AL RL Restored AL R
; RS Recess RS Recess r
; HX Holiday Excused HX Holiday Excused h
; ML Military Leave ML Military Leave M
; SL Sick Leave SL Sick Leave S
; WP Leave w/o Pay WP Leave w/o Pay W
; NL Non-Pay AL NL Non-Pay AL n
; NP Non-Pay NP Non-Pay N
; Tour Time (posted) WI Work in tour W
; TR Train (in tour) TR Work in Tour W
; TV Travel (in tour) TV Work in Tour W
; OT Overtime WO Work out of tour w
; CT Comp/Cred Earn WO Work out of tour w
; RG Reg Sched WO Work out of tour w
; HW Hol Work (in tour) HW H
; UN Unavailable Not reported Ignored
; ON On-Call Not reported Ignored
; SB Standby Not reported Ignored
;
N TC,CC,CODEPOS
S CC="AADLBUdRrhMSWnNWWWwwwwH000"
S TC="AA^CP^AD^AL^CB^CU^DL^RL^RS^HX^ML^SL^WP^NL^NP^WI^TR^TV^WO^OT^CT^RG^HW^UN^ON^SB^"
S CODEPOS=$FIND(TC,TT)
Q $E(CC,CODEPOS/3)
;
TIMEPOS(MT,SORE) ; Convert MILTIME to positional int. where 1 represents
; the period from Mid-12:15, 2 - 12:15-12:30, and so on, with 96
; representing the period from 11:45pm to mid.
;
; INPUT:
; MT: military time from 0 to 4800 (2 day clock)
; SORE-flag 0 for start time 1 for end time (required)
; OUTPUT:
; integer value specifying the position in a string
; where each position represents a 15 minute increment of the day
; 0=1
; 15=2
; 30=3
; ...
; 300=13
; 315=14
; ...
; 1000=50
; ...
; 1100=55
;
Q ((MT\100)*4)+((("."_$P(MT/100,".",2))*100)/15)+$G(SORE)
;
POSTIM(I,BORE) ; convert the positional integer time to military time
; INPUT: BORE-0=START, 1=END, flag specifies if this is a
; start time or end time
N MINS
S I=I-$G(BORE)
S MINS=I#4*15 I 'MINS S MINS="00"
Q (I\4)_MINS
;
;
ETIM(MIL) ; Convert a military time to a standard time
;
N T,H,M
I (MIL#2400)=0 Q "MID"
I (MIL#1200)=0 Q "NOON"
S T=MIL/100 S H=$P(T,".",1),M=$P(T,".",2)
I (H#12)=0 Q "12"_":"_M_$S(H=12:"PM",H=24:"AM",1:"PM")
S M=$S($L(M)=0:"00",$L(M)=1:M_"0",1:M)
I (MIL<1200) Q H_":"_M_"AM"
I MIL>1200,MIL<2400 Q H-12_":"_M_"PM"
I MIL>2400,MIL<3600 Q H-24_":"_M_"AM"
I MIL>3600 Q H-36_":"_M_"PM"
Q -1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRMM 16035 printed Dec 13, 2024@02:27:29 Page 2
PRSNRMM ;WOIFO-JAH - POC Record and Timecard Mismatches;07/31/09
+1 ;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
PPMM(PRSIEN,PPI,PG,STOP) ; report mismatches for a pay period
+1 NEW PRSD,MM
+2 SET STOP=+$GET(STOP)
+3 SET PG=+$GET(PG)
+4 DO HDR(.STOP,1,PRSIEN,PPI,.PG)
+5 FOR PRSD=1:1:14
if STOP
QUIT
Begin DoDot:1
+6 KILL MM
+7 DO DAILYMM(.MM,PRSIEN,PPI,PRSD)
+8 if MM(0)'>0
QUIT
+9 WRITE !!,$PIECE($GET(^PRST(458,PPI,2)),U,PRSD)
+10 DO DISPMM(.MM,.STOP,1,PRSIEN,PPI,PRSD)
+11 IF (IOSL-4)<$Y
DO HDR(.STOP,1,PRSIEN,PPI,.PG)
End DoDot:1
+12 QUIT
DISPMM(MM,STOP,HDR,PRSIEN,PPI,PRSD) ; Display a single day of mismatches between
+1 ; a timecard and a POC record
+2 ; INPUT:
+3 ; MM-(array by reference) call DAILYMM to get an array of
+4 ; mismatches to pass to this display routine
+5 ; PPI-(required) pay period IEN
+6 ; PRSD-(required) day number in pay period referenced in PPI
+7 ; HDR-(optional) set to true if you want a header included
+8 ;
+9 ; OUTPUT:
+10 ; STOP-reference variable returned as true if the user was
+11 ; prompted to continue and responded with an '^' to quit
+12 ;
+13 NEW T1,T2,TT,P1,P2,PT,PTE,TTE,MISM,DASH
+14 IF $GET(STOP)'>0
SET STOP=0
+15 IF $GET(HDR)'>0
SET HDR=0
+16 SET DASH=" -"
+17 SET J=0
+18 FOR
SET J=$ORDER(MM(J))
if J'>0!STOP
QUIT
Begin DoDot:1
+19 IF (IOSL-4)<$Y
DO HDR(.STOP,HDR,PRSIEN,PPI,.PG)
+20 if STOP
QUIT
+21 SET MISM=$GET(MM(J))
+22 SET T1=$$ETIM($PIECE(MISM,U))
+23 SET T2=$$ETIM($PIECE(MISM,U,2))
+24 SET TT=$PIECE(MISM,U,3)
+25 SET TTE=$PIECE(MISM,U,4)
+26 SET P1=$$ETIM($PIECE(MISM,U,5))
+27 SET P2=$$ETIM($PIECE(MISM,U,6))
+28 SET PT=$PIECE(MISM,U,7)
+29 SET PTE=$PIECE(MISM,U,8)
+30 WRITE !,$JUSTIFY(T1,7),DASH,$JUSTIFY(T2,7),?19,TT,?24,TTE,?40,$JUSTIFY(P1,7),DASH,$JUSTIFY(P2,7),?60,PT,?64,PTE
End DoDot:1
+31 QUIT
HDR(STOP,HDR,PRSIEN,PPI,PG) ;
+1 IF PG>0
SET STOP=$$ASK^PRSLIB00()
+2 if STOP
QUIT
+3 WRITE @IOF,!
SET PG=PG+1
+4 IF HDR
Begin DoDot:1
+5 NEW PPE,PPBEG,PPEND,TITLE,TITLE2,PGE,RUNDATE
+6 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U)
+7 SET PPBEG=$PIECE($GET(^PRST(458,PPI,2)),U,1)
+8 SET PPEND=$PIECE($GET(^PRST(458,PPI,2)),U,14)
+9 SET TITLE="Mismatch Report Between ETA Timecard & Point of Care Record"
+10 SET TITLE2="for Pay Period "_PPE_" ("_PPBEG_" - "_PPEND_")"
+11 WRITE ?((IOM-$LENGTH(TITLE))\2),TITLE
+12 WRITE !,?((IOM-$LENGTH(TITLE2))\2),TITLE2
+13 SET PGE="Page "_PG
+14 IF PG>0
WRITE ?(IOM-$LENGTH(PGE)-2),PGE
+15 SET RUNDATE="Run Date: "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+16 WRITE !,?3,"Nurse: ",$PIECE($GET(^PRSPC(PRSIEN,0)),U)
+17 WRITE ?(IOM-$LENGTH(RUNDATE)-3),RUNDATE
+18 WRITE !!,?9,"ETA TIMECARD",?46,"POINT OF CARE RECORD"
+19 WRITE !,?2,"=================================",?40,"==================================="
End DoDot:1
+20 QUIT
DAILYMM(MM,PRSIEN,PPI,PRSD) ;
+1 ; INPUT:
+2 ; PRSIEN: 450/451 IEN
+3 ; PPI: 451/458 Pay Period IEN
+4 ; PRSD: day 1-14 of pay period
+5 ; OUTPUT:
+6 ; MM - mismatch array index 1..n for each mismatch
+7 ; MM(0) = number of mismatches and zero for none
+8 ; MM(0+n) = TC Seg start^TC Seg Stop^TT^POC seg start^POC seg stop^TT
+9 ;
+10 ;Loop through Timecard storing types of time in TD string and TD array
+11 ;
+12 NEW ND,TD
+13 SET MM(0)=0
+14 DO BLDTC(.TD,PRSIEN,PPI,PRSD,0)
+15 ;
+16 ; Loop through POC Record storing time in ND string and ND array
+17 ;
+18 DO BLDPOC(.ND,PRSIEN,PPI,PRSD,0)
+19 IF '$DATA(ND)
SET MM="-1^NO POC RECORD"
QUIT
+20 ;
+21 ; Strings will look like
+22 ;
+23 ; TD="00000000000000000AAAAAAAAAAAAAAAAAA000000000000000000000..."
+24 ; ND="00000000000000000AAAAAAAAAAAAAAAAAAWWWWWWWWWWWWWWWWWWW00..."
+25 ;
+26 ;
+27 ; arrays will look like:
+28 ;
+29 ; TD(0)=code^segment start^segment stop^ETA TT
+30 ; TD(1)=code^segment start^segment stop^ETA TT
+31 ; TD(3)=code^segment start^segment stop^ETA TT
+32 ; TD(4)=code^segment start^segment stop^ETA TT
+33 ; .....
+34 ; TD(188)=code^segment start^segment stop^ETA TT
+35 ; TD(189)=code^segment start^segment stop^ETA TT
+36 ; TD(190)=code^segment start^segment stop^ETA TT
+37 ;
+38 ; ND(0)=code^segment start^segment stop^POC TT
+39 ; ND(1)=code^segment start^segment stop^POC TT
+40 ; .....
+41 ; ND(191)=code^segment start^segment stop^POC TT
+42 ; ND(192)=code^segment start^segment stop^POC TT
+43 ;
+44 ; If strings match there are no mismatches and we are done.
+45 ;
+46 IF ND=TD
QUIT
+47 ;
+48 ; traverse strings until first mismatched characters are found.
+49 ; Once a mismatch is found determine the segments associated with
+50 ; each of the corresponding characters that mismatch.
+51 ; This can easily be found because the ND and TD arrays have
+52 ; stored the start and stop of each segment in the node where
+53 ; corresponding to the position in the ND and TD strings.
+54 ;
+55 NEW TCBEG,TCEND,TCBEGI,TCENDI,POCTT,POCBEGI,POCENDI,POCBEG,POCEND
+56 NEW I,POCTT,POCTTE,TCTT,TCTTE
+57 FOR I=1:1:192
IF $EXTRACT(ND,I)'=$EXTRACT(TD,I)
Begin DoDot:1
+58 SET MM(0)=MM(0)+1
+59 SET TCTT=$PIECE(TD(I),U,5)
+60 SET TCTTE=$$TTE^PRSPSAPU(TCTT)
+61 IF $PIECE(TD(I),U,2)="Z"
SET TCTT=""
SET TCTTE="Unposted Tour"
+62 SET TCBEGI=+$PIECE(TD(I),U,3)
+63 SET TCENDI=+$PIECE(TD(I),U,4)
+64 SET POCTT=$PIECE(ND(I),U,5)
+65 SET POCTTE=$$TTE^PRSPSAPU(POCTT)
+66 SET POCBEGI=+$PIECE(ND(I),U,3)
+67 SET POCENDI=+$PIECE(ND(I),U,4)
+68 SET TCBEG=+$GET(TD(TCBEGI))
+69 SET TCEND=+$GET(TD(TCENDI+1))
+70 SET POCBEG=+$GET(ND(POCBEGI))
+71 SET POCEND=+$GET(ND(POCENDI+1))
+72 ; Adjust end points of segment for clearer reporting when
+73 ; POC or ETA has no data at the point of mismatch
+74 IF $EXTRACT(TD,I)=0
Begin DoDot:2
+75 IF TCENDI>POCENDI
SET TCEND=+$GET(ND(POCENDI+1))
+76 IF TCBEGI<POCBEGI
SET TCBEG=+$GET(ND(POCBEGI))
+77 SET TCTTE="No Data"
End DoDot:2
+78 IF $EXTRACT(ND,I)=0
Begin DoDot:2
+79 IF POCENDI>TCENDI
SET POCEND=+$GET(TD(TCENDI+1))
+80 IF POCBEGI<TCBEGI
SET POCBEG=+$GET(TD(TCBEGI))
+81 SET POCTTE="No Data"
End DoDot:2
+82 SET MM(+MM(0))=TCBEG_U_TCEND_U_TCTT_U_TCTTE_U_POCBEG_U_POCEND_U_POCTT_U_POCTTE
+83 ; start the search back up at the end of the shorter segment
+84 ; unless there is no time in the shorter segment
+85 IF POCENDI=0
SET I=TCENDI
QUIT
+86 IF TCENDI=0
SET I=POCENDI
QUIT
+87 IF POCENDI>TCENDI
Begin DoDot:2
+88 SET I=TCENDI
End DoDot:2
+89 IF '$TEST
Begin DoDot:2
+90 SET I=POCENDI
End DoDot:2
End DoDot:1
+91 QUIT
BLDPOC(ND,PRSIEN,PPI,PRSD,ACTIVITY) ; Build string and array from POC day
+1 ; initialize ND
+2 ; INPUT:
+3 ; PRSIEN: 450 IEN
+4 ; PPI: 458/451 IEN
+5 ; PRSD: Pay period day number 1-14
+6 ; ACTIVITY: flag set to true if you want to have only portions
+7 ; of the array with activity to be returned.
+8 ; ND: activity string and array
+9 ;
+10 NEW I,POCD,J,CC,SET,T1,T2,TT,SEG
+11 FOR I=1:1:192
SET $EXTRACT(ND,I)=0
+12 FOR I=1:1:193
SET ND(I)=+$$POSTIM(I,1)
+13 DO L1^PRSNRUT1(.POCD,PPI,PRSIEN,PRSD)
+14 SET SEG=0
+15 FOR
SET SEG=$ORDER(POCD(SEG))
if SEG'>0
QUIT
Begin DoDot:1
+16 SET T1=$$TIMEPOS($PIECE(POCD(SEG),U,9),1)
+17 SET T2=$$TIMEPOS($PIECE(POCD(SEG),U,10),0)
+18 SET TT=$PIECE(POCD(SEG),U,4)
+19 SET CC=$$CONVERT(TT)
+20 FOR J=T1:1:T2
if J>192
QUIT
SET $PIECE(ND(J),U,2,5)=CC_U_T1_U_T2_U_TT
SET $EXTRACT(ND,J)=CC
End DoDot:1
+21 ; loop through activity again to update all the start and stop
+22 ; times for each segment, this will give segment start and stops
+23 ; to periods where there is no data
+24 ;
+25 NEW LQH,NEWSTART,QH,NEWEND
+26 SET LQH=0
SET NEWSTART=1
+27 FOR I=1:1:192
Begin DoDot:1
+28 SET QH=$EXTRACT(ND,I)
+29 IF LQH'=QH
SET NEWSTART=I
SET LQH=QH
+30 SET $PIECE(ND(I),U,3)=NEWSTART
End DoDot:1
+31 ;
+32 SET LQH=0
SET NEWEND=192
+33 FOR I=192:-1:1
Begin DoDot:1
+34 SET QH=$EXTRACT(ND,I)
+35 IF LQH'=QH
SET NEWEND=I
SET LQH=QH
+36 SET $PIECE(ND(I),U,4)=NEWEND
End DoDot:1
+37 ;
+38 ;
+39 ; If activity is true remove all nodes with no activity
+40 ;
+41 IF ACTIVITY
Begin DoDot:1
+42 FOR I=1:1:193
IF $PIECE($GET(ND(I)),U,2)=""
KILL ND(I)
+43 SET ND=0
End DoDot:1
+44 ;
+45 QUIT
BLDTC(TD,PRSIEN,PPI,PRSD,ACTIVITY) ; Build string and array from Time Card day
+1 ; initialize TD
+2 ; INPUT: standard PRSIEN, PPI, PRSD
+3 ; ACTIVITY-(optional) flag set to true if return array
+4 ; should only contain nodes with activity
+5 ; OUTPUT:
+6 ; TD (string) with 192 characters representing each 15 minutes of
+7 ; the day
+8 ; if ACTIVITY parameter true then TD string will be set as follows:
+9 ; TD = timecard posting status ^ tour of duty IEN
+10 ;
+11 ; TD(1..192)--array with nodes of activity for each 15 min.
+12 ;
+13 NEW I,J,CC,SET,TS,TE,TOUR,T1,T2,TT,TC,TOD,TODD,TCD,X,Y,POSTED,DAYOFF,SEG,NEWSTART,NEWEND,LQH,POC,QH
+14 FOR I=1:1:193
SET TD(I)=+$$POSTIM(I,1)
+15 DO LOADTOD^PRSPLVU(PPI,PRSIEN,PRSD,.TOD,.TODD)
+16 DO LOADTC^PRSPLVU(PPI,PRSIEN,PRSD,.TCD)
+17 ;
+18 ; Check for no time posted on the timecard
+19 NEW X0,PSTAT
+20 SET X0=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
+21 ;
+22 ; posting status--(T)imekeeper, (P)ayroll, (X)mitted
+23 SET PSTAT=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,10)),U,1)
+24 ;
+25 ; tour of duty (1=day off, 3,4=intermittent)
+26 SET TC=$PIECE(X0,U,2)
+27 SET POSTED=1
+28 ; - no posting to tour
IF "1 3 4"'[TC
IF PSTAT=""
SET (PSTAT,POSTED)=0
+29 ;
+30 FOR I=1:1:192
SET $EXTRACT(TD,I)=0
+31 ;
+32 SET SEG=0
+33 FOR
SET SEG=$ORDER(TOD(SEG))
if SEG'>0
QUIT
Begin DoDot:1
+34 SET TT=$PIECE(TOD(SEG),U,3)
+35 IF TT="RG"
SET TT="WI"
+36 SET CC=$$CONVERT(TT)
+37 SET POC=$$CNVTTPOC(TT)
+38 IF 'POSTED
SET CC="Z"
+39 SET T1=$PIECE(TOD(SEG),U,4)
+40 SET X=T1
SET Y=0
DO MIL^PRSATIM
SET T1=Y
+41 SET T2=$PIECE(TOD(SEG),U,5)
+42 SET X=T2
SET Y=1
DO MIL^PRSATIM
SET T2=Y
+43 ; if the start time is earlier than the stop time then it
+44 ; must be a time on a second day of a two day tour
+45 IF T1>T2
SET T2=T2+2400
+46 SET TOUR(T1)=T2
+47 SET T1=$$TIMEPOS(T1,1)
+48 SET T2=$$TIMEPOS(T2,0)
+49 FOR J=T1:1:T2
if J>192
QUIT
SET $PIECE(TD(J),U,2,6)=CC_U_T1_U_T2_U_TT_U_POC
SET $EXTRACT(TD,J)=CC
End DoDot:1
+50 ;
+51 ; place posted exceptions
+52 ;
+53 SET SEG=0
+54 FOR
SET SEG=$ORDER(TCD(SEG))
if SEG'>0
QUIT
Begin DoDot:1
+55 SET TT=$PIECE(TCD(SEG),U,3)
+56 SET T1=$PIECE(TCD(SEG),U,4)
+57 SET X=T1
SET Y=0
DO MIL^PRSATIM
SET T1=Y
+58 SET T2=$PIECE(TCD(SEG),U,5)
+59 SET X=T2
SET Y=1
DO MIL^PRSATIM
SET T2=Y
+60 ; try to place exceptions on the correct day
+61 SET T1=$$PLACEX(T1,T2,.TOUR)
+62 ; if the start time is earlier than the stop time then it
+63 ; must be a time on a second day of a two day tour
+64 IF T1>T2
SET T2=T2+2400
+65 SET T1=$$TIMEPOS(T1,1)
+66 SET T2=$$TIMEPOS(T2,0)
+67 SET CC=$$CONVERT(TT)
+68 SET POC=$$CNVTTPOC(TT)
+69 FOR J=T1:1:T2
if J>192
QUIT
SET $PIECE(TD(J),U,2,6)=CC_U_T1_U_T2_U_TT_U_POC
SET $EXTRACT(TD,J)=CC
End DoDot:1
+70 ;
+71 ; place meal
+72 ;TODD(1)="3090917^3090918.08^30^2"
+73 NEW LEN,LONGSEG,MEAL,EN,STPOS,ENPOS,MIDPOS,MLOC,ST
+74 IF +$PIECE($GET(TODD(1)),U,3)>0
Begin DoDot:1
+75 SET MEAL=0
+76 FOR
SET MEAL=$ORDER(TODD(MEAL))
if MEAL'>0
QUIT
Begin DoDot:2
+77 SET LEN=$PIECE(TODD(MEAL),U,3)
+78 ; Patch PRS*4.0*142 adds a QUIT condition in the event that LONGSEG equals null.
+79 SET LONGSEG=$PIECE(TODD(MEAL),U,4)
IF 'LONGSEG
QUIT
+80 ;;;;;; start of longest tour segment
+81 SET ST=$PIECE(TOD(MEAL_"-"_LONGSEG),U,4)
+82 SET X=ST
SET Y=0
DO MIL^PRSATIM
SET ST=Y
+83 ;;;;;; end of longest tour segment
+84 SET EN=$PIECE(TOD(MEAL_"-"_LONGSEG),U,5)
+85 SET X=EN
SET Y=1
DO MIL^PRSATIM
SET EN=Y
+86 ;
+87 IF ST>EN
SET EN=EN+2400
+88 ;;;;;;
+89 SET STPOS=$$TIMEPOS(ST,1)
+90 SET ENPOS=$$TIMEPOS(EN,0)
+91 SET MIDPOS=STPOS+((ENPOS-STPOS)\2)
+92 ;;;;;;; get starting location of the segment where this midway falls
+93 SET MLOC=$PIECE(TD(MIDPOS),U,3)
+94 SET $PIECE(TD(MLOC),U,7)=LEN
End DoDot:2
End DoDot:1
+95 ; loop through activity again to update all the start and stop
+96 ; times for each segment, since exceptions that overwrote the tour
+97 ; will change the start and stops for subsections of tour
+98 ;
+99 SET LQH=0
SET NEWSTART=1
+100 FOR I=1:1:192
Begin DoDot:1
+101 SET QH=$EXTRACT(TD,I)
+102 IF LQH'=QH
SET NEWSTART=I
SET LQH=QH
+103 SET $PIECE(TD(I),U,3)=NEWSTART
End DoDot:1
+104 ;
+105 SET LQH=0
SET NEWEND=192
+106 FOR I=192:-1:1
Begin DoDot:1
+107 SET QH=$EXTRACT(TD,I)
+108 IF LQH'=QH
SET NEWEND=I
SET LQH=QH
+109 SET $PIECE(TD(I),U,4)=NEWEND
End DoDot:1
+110 ;
+111 ; If activity is true remove all nodes with no activity
+112 ;
+113 IF ACTIVITY
Begin DoDot:1
+114 FOR I=1:1:193
IF $PIECE($GET(TD(I)),U,2)=""
KILL TD(I)
+115 SET TD=PSTAT_U_TC
End DoDot:1
+116 ;
+117 QUIT
+118 ;
PLACEX(T1,T2,TOUR) ;
+1 ;
+2 NEW TS,TE,NEWT1,TEMPT1
+3 ;need to make two passes on the tour array as there may be more than one tour
+4 ;and need to make sure that the exception doesn't fit within any tour before adjusting
+5 SET NEWT1=""
+6 SET TS=""
+7 FOR
SET TS=$ORDER(TOUR(TS))
if TS=""
QUIT
Begin DoDot:1
+8 SET TE=TOUR(TS)
+9 IF T1'<TS
Begin DoDot:2
+10 ; this time segment falls within the tour, so fits
+11 IF T1'>TE
SET NEWT1=T1
QUIT
+12 ; this time segment starts no more than 4 hours after tour, then probably fits
+13 IF $$TIMEDIF(TE,T1)'>240
SET NEWT1=T1
QUIT
End DoDot:2
if NEWT1'=""
QUIT
+14 IF T1<TS
Begin DoDot:2
+15 ; this time segment starts no more than 4 hours before tour, then probably fits
+16 IF $$TIMEDIF(T1,TS)'>240
SET NEWT1=T1
QUIT
End DoDot:2
if NEWT1'=""
QUIT
End DoDot:1
if NEWT1'=""
QUIT
+17 ;
+18 IF NEWT1'=""
QUIT NEWT1
+19 ;
+20 ; looks like we have a segment that should be starting in day two
+21 ; but need to see if that fits
+22 SET TEMPT1=T1+2400
+23 SET TS=""
+24 FOR
SET TS=$ORDER(TOUR(TS))
if TS=""
QUIT
Begin DoDot:1
+25 SET TE=TOUR(TS)
+26 IF TEMPT1'<TS
Begin DoDot:2
+27 ; this time segment falls within the tour, so fits
+28 IF TEMPT1'>TE
SET NEWT1=TEMPT1
QUIT
+29 ; this time segment starts no more than 4 hours after tour, then probably fits
+30 IF $$TIMEDIF(TE,TEMPT1)'>240
SET NEWT1=TEMPT1
QUIT
End DoDot:2
if NEWT1'=""
QUIT
End DoDot:1
if NEWT1'=""
QUIT
+31 ;
+32 ;if we didn't find it earlier, then just leave it as the originally entered time
+33 ;and if that is wrong, user will need to adjust it
+34 IF NEWT1=""
SET NEWT1=T1
+35 ;
+36 QUIT NEWT1
+37 ;
TIMEDIF(TIME1,TIME2) ;
+1 ;
+2 ;SUBTRACT TIME1 FROM TIME2
+3 ;RETURN TIME DIFFERENCE IN MINUTES
+4 NEW HOUR,MIN,DIFF,MIN1,MIN2
+5 SET MIN=TIME1#100
SET HOUR=TIME1\100
SET MIN1=HOUR*60+MIN
+6 SET MIN=TIME2#100
SET HOUR=TIME2\100
SET MIN2=HOUR*60+MIN
+7 SET DIFF=MIN2-MIN1
+8 QUIT DIFF
+9 ;
CNVTTPOC(TT) ; convert an ETA type of time to POC time
+1 NEW TC,POC,CODEPOS
+2 SET POC="AA^AA^AD^AL^CB^CU^DL^RL^RS^HX^ML^SL^WP^NL^NP^WI^TR^TV^WO^WO^WO^WO^HW^^^^"
+3 SET TC="AA^CP^AD^AL^CB^CU^DL^RL^RS^HX^ML^SL^WP^NL^NP^WI^TR^TV^WO^OT^CT^RG^HW^UN^ON^SB^"
+4 SET CODEPOS=$FIND(TC,TT)
+5 QUIT $PIECE(POC,U,CODEPOS/3)
+6 ;
CONVERT(TT) ; Convert a type of time code to a comparison code
+1 ; COMPARISON
+2 ; ETA POC STRINGS
+3 ; CODE ETA DX CODE POC DX CODE
+4 ; ==== =============== ===== =========== =====
+5 ; AA Auth Abs AA Auth Abs A
+6 ; CP Cont of Pay AA Auth Abs A
+7 ; AD Adoption AD Adoption D
+8 ; AL Annual Leave AL Annual Leave L
+9 ; CB Fam Care Bereav CB Fam Care Bereav B
+10 ; CU Comp/Cred Used CU Comp/Cred Used U
+11 ; DL Donor Leave DL Donor Leave d
+12 ; RL Restored AL RL Restored AL R
+13 ; RS Recess RS Recess r
+14 ; HX Holiday Excused HX Holiday Excused h
+15 ; ML Military Leave ML Military Leave M
+16 ; SL Sick Leave SL Sick Leave S
+17 ; WP Leave w/o Pay WP Leave w/o Pay W
+18 ; NL Non-Pay AL NL Non-Pay AL n
+19 ; NP Non-Pay NP Non-Pay N
+20 ; Tour Time (posted) WI Work in tour W
+21 ; TR Train (in tour) TR Work in Tour W
+22 ; TV Travel (in tour) TV Work in Tour W
+23 ; OT Overtime WO Work out of tour w
+24 ; CT Comp/Cred Earn WO Work out of tour w
+25 ; RG Reg Sched WO Work out of tour w
+26 ; HW Hol Work (in tour) HW H
+27 ; UN Unavailable Not reported Ignored
+28 ; ON On-Call Not reported Ignored
+29 ; SB Standby Not reported Ignored
+30 ;
+31 NEW TC,CC,CODEPOS
+32 SET CC="AADLBUdRrhMSWnNWWWwwwwH000"
+33 SET TC="AA^CP^AD^AL^CB^CU^DL^RL^RS^HX^ML^SL^WP^NL^NP^WI^TR^TV^WO^OT^CT^RG^HW^UN^ON^SB^"
+34 SET CODEPOS=$FIND(TC,TT)
+35 QUIT $EXTRACT(CC,CODEPOS/3)
+36 ;
TIMEPOS(MT,SORE) ; Convert MILTIME to positional int. where 1 represents
+1 ; the period from Mid-12:15, 2 - 12:15-12:30, and so on, with 96
+2 ; representing the period from 11:45pm to mid.
+3 ;
+4 ; INPUT:
+5 ; MT: military time from 0 to 4800 (2 day clock)
+6 ; SORE-flag 0 for start time 1 for end time (required)
+7 ; OUTPUT:
+8 ; integer value specifying the position in a string
+9 ; where each position represents a 15 minute increment of the day
+10 ; 0=1
+11 ; 15=2
+12 ; 30=3
+13 ; ...
+14 ; 300=13
+15 ; 315=14
+16 ; ...
+17 ; 1000=50
+18 ; ...
+19 ; 1100=55
+20 ;
+21 QUIT ((MT\100)*4)+((("."_$PIECE(MT/100,".",2))*100)/15)+$GET(SORE)
+22 ;
POSTIM(I,BORE) ; convert the positional integer time to military time
+1 ; INPUT: BORE-0=START, 1=END, flag specifies if this is a
+2 ; start time or end time
+3 NEW MINS
+4 SET I=I-$GET(BORE)
+5 SET MINS=I#4*15
IF 'MINS
SET MINS="00"
+6 QUIT (I\4)_MINS
+7 ;
+8 ;
ETIM(MIL) ; Convert a military time to a standard time
+1 ;
+2 NEW T,H,M
+3 IF (MIL#2400)=0
QUIT "MID"
+4 IF (MIL#1200)=0
QUIT "NOON"
+5 SET T=MIL/100
SET H=$PIECE(T,".",1)
SET M=$PIECE(T,".",2)
+6 IF (H#12)=0
QUIT "12"_":"_M_$SELECT(H=12:"PM",H=24:"AM",1:"PM")
+7 SET M=$SELECT($LENGTH(M)=0:"00",$LENGTH(M)=1:M_"0",1:M)
+8 IF (MIL<1200)
QUIT H_":"_M_"AM"
+9 IF MIL>1200
IF MIL<2400
QUIT H-12_":"_M_"PM"
+10 IF MIL>2400
IF MIL<3600
QUIT H-24_":"_M_"AM"
+11 IF MIL>3600
QUIT H-36_":"_M_"PM"
+12 QUIT -1
