Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSNRMM

PRSNRMM.m

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