PRSXP79 ;WCIOFO/MGD-MANDATORY HOURS REPORT ;08/14/2002
;;4.0;PAID;**79**;Sep 21, 1995
;
Q
;
; This program will create a report on the number of Normal Hours
; Unscheduled Hours, Overtime Hours and Compensatory Hours worked
; by nurses from the years 1997 through 2001.
;
; This program is read only and will not alter any VistA/PAID data.
;
; For more details see the patch description on FORUM.
;
START ; Main Driver
;
K ^TMP($J),TMP
N STANUM,TMP,U
S U="^"
W !!,"This report may take over an hour to run."
D NOW^%DTC
S Y=%
D DD^%DT
W !!,Y
W !,">>>> Starting to compile reports.",!!
;
; Get Station Number
;
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
;
D RPT
W !!,">>>> Reports completed. Mail messages sent."
D NOW^%DTC
S Y=%
D DD^%DT
W !,Y
K %,TMP,^TMP($J),Y
Q
;----------------------------------------------------------------;
RPT ; Reports ;
;----------------------------------------------------------------;
;
N OCC,DATA0,EMP,PRS,SSN,STA,VISN
;
; Create Temporary Global listing of employees with OCCUPATION SERIES
; & TITLE Codes beginning with 0605,0610,0620 and 0621
;
EMP S EMP=0
F S EMP=$O(^PRSPC(EMP)) Q:'EMP D
. S DATA0=$G(^PRSPC(EMP,0))
. Q:DATA0=""
. S OCC=$E($P(DATA0,U,17),1,4)
. I OCC="0605"!(OCC="0610")!(OCC="0620")!(OCC="0621") D
. . S SSN=$P(DATA0,U,34)
. . I SSN="" S SSN=$P(DATA0,U,9)
. . Q:SSN=""
. . S STA=+$P(DATA0,U,7)
. . Q:'STA
. . ;
. . ; Get the VISN number from the employee's STATION NUMBER (#6)
. . ;
. . D PARENT^XUAF4("PRS",STA,"VISN")
. . S (PRS,VISN)=""
. . S PRS=$O(PRS("P",PRS))
. . Q:'PRS
. . S VISN=$P(PRS("P",PRS),U,1)
. . Q:VISN=""
. . S ^TMP($J,OCC,EMP)=SSN_"^"_VISN_"^"_STA
Q:'$D(^TMP($J))
;
; Get IEN for year in files
;
IEN N IEN458,IEN459,PP,PRSD,XPDIDTOT,YEAR
S PRSD("TOT")=131 ; # of pay period processed
S PRSD("IE")=0 ; # of Items Evaluated
S XPDIDTOT=PRSD("TOT") ; Set total for Status Bar
S PRSD("UPD")=5 ; Initial % required to update Status Bar
F YEAR=97,98,99,"00","01" D
. F PP="01","02","03","04","05","06","07","08","09",10:1:27 D
. . ;
. . ; The following code will update the % Complete Status Bar
. . ; during the installation of the patch.
. . ;
. . S PRSD("IE")=PRSD("IE")+1
. . S PRSD("%")=PRSD("IE")*100/PRSD("TOT") ; Calculate % complete
. . ;
. . ; Check if Status Bar should be updated
. . ;
. . I PRSD("%")>PRSD("UPD") D
. . . D UPDATE^XPDID(PRSD("IE")) ; Update Status Bar
. . . S PRSD("UPD")=PRSD("UPD")+5 ; Increase update criteria by 5%
. . ;
. . ; Get IEN for the TIME & ATTENDANCE RECORDS (#458) file
. . S IEN458=""
. . S IEN458=$O(^PRST(458,"B",YEAR_"-"_PP,IEN458))
. . Q:'IEN458
. . ;
. . ; Get IEN for the PAID PAYRUN DATA (#459) file
. . ;
. . S IEN459=""
. . S IEN459=$O(^PRST(459,"B",YEAR_"-"_PP,IEN459))
. . Q:'IEN459
. . D GETDATA
D STORE^PRSXP79A
D XMIT^PRSXP79A
Q
;
GETDATA ; Loop through OCC codes checking for data in the TIME & ATTENDANCE
; RECORDS (#458) and PAID PAYRUN DATA (#459) files.
;
N ZERO459,DATA
F OCC="0605","0610","0620","0621" D
. S EMP=""
. F S EMP=$O(^TMP($J,OCC,EMP)) Q:'EMP D
. . ;
. . ; Load SSN, VISN and STA
. . ;
. . S DATA=$G(^TMP($J,OCC,EMP))
. . Q:DATA=""
. . S SSN=$P(DATA,U,1),VISN=$P(DATA,U,2),STA=$P(DATA,U,3)
. . Q:SSN=""!(VISN="")!(STA="")
. . ;
. . ; Quit if they didn't have an entry in the TIME & ATTENDANCE
. . ; RECORDS (#458) file for the pay period in question
. . ;
. . Q:'$D(^PRST(458,IEN458,"E",EMP,0))
. . ;
. . ; Quit if they didn't have an entry in the PAID PAYRUN DATA (#459)
. . ; file for the pay period in question
. . ;
. . S ZERO459=$G(^PRST(459,IEN459,"P",EMP,0))
. . Q:ZERO459=""
. . ;
. . ; Quit if the employee was Intermittent during the pay period
. . ; in question
. . ;
. . Q:$P(ZERO459,U,6)=3
. . ;
. . ; Verify that the employee's SUBACCT CODE (#8) during the pay
. . ; period in question corresponds to one of the SUBACCT CODEs
. . ; assigned to nurses (i.e. 60 - 67)
. . ;
. . Q:$P(ZERO459,U,9)<60&($P(ZERO459,U,9)>67)
. . ;
. . D REVDAY
Q
REVDAY ; Review each day in the pay period to determine if any work
; was performed
N COUNTED,DAY,EXCEPT,TINFO,TOUR1,TOUR2,TOURS,YR
S COUNTED=0
F DAY=1:1:14 D
. S TINFO=$G(^PRST(458,IEN458,"E",EMP,"D",DAY,0))
. S TOUR1=$G(^PRST(458,IEN458,"E",EMP,"D",DAY,1))
. S TOUR2=$G(^PRST(458,IEN458,"E",EMP,"D",DAY,4))
. S EXCEPT=$G(^PRST(458,IEN458,"E",EMP,"D",DAY,2))
. ;
. ; Quit if no data for any tour or exception
. ;
. Q:TOUR1=""&(TOUR2="")&(EXCEPT="")
. ;
. ; Quit if it is the employee's day off and there are no exceptions
. ;
. Q:$P(TINFO,U,2)=1&(TOUR2="")&(EXCEPT="")
. ;
. ; Record Normal Hours scheduled to work
. ;
. I $P(TINFO,U,2)'=1 D
. . ;
. . ; Update Normal Hours worked for report # 1
. . ;
. . S $P(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA),U,3)=$P($G(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,3)+$P(TINFO,U,8)
. . ;
. . ; Check if it is the last pay period of the year
. . ;
. . I PP=26 S $P(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA),U,2)="Y"
. . I PP>25&(YEAR="00")!(PP<25&(YEAR="01")) D
. . . S $P(^TMP($J,"RPT2",SSN,OCC,VISN,STA),U,2)="Y"
. . ;
. . ; Update employee count
. . ;
. . I 'COUNTED D
. . . S $P(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA),U,1)=$P($G(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,1)+1
. . . I PP>25&(YEAR="00")!(PP<25&(YEAR="01")) D
. . . . S $P(^TMP($J,"RPT2",SSN,OCC,VISN,STA),U,1)=$P($G(^TMP($J,"RPT2",SSN,OCC,VISN,STA)),U,1)+1
. . . S COUNTED=1
. ;
. ; Quit if there is no second tour or exceptions
. ;
. Q:TOUR2=""&(EXCEPT="")
. ;
. ; Otherwise check Tour 2 and the exceptions for other types of time
. ; to include in the report. Then check the exceptions for any types
. ; of approved leave that would remove hours from the report.
. ;
. F TOURS="TOUR2","EXCEPT" D
. . ;
SEG . . ; Loop through segments of tour or exception
. . ;
. . N ADDSUB,ALLTOUR,CODE,CODE2,END,HRSWRK,SEG,START,TOUR,X
. . Q:@TOURS=""
. . F SEG=1:4:21 D
. . . S (ALLTOUR,TOUR)=0
. . . S START=$P(@TOURS,U,SEG)
. . . S END=$P(@TOURS,U,SEG+1)
. . . S CODE=$P(@TOURS,U,SEG+2)
. . . S CODE2=4
. . . S ADDSUB=1
. . . ;
. . . ; Quit if the start or stop time is missing
. . . ;
. . . Q:START=""!(END="")
. . . ;
. . . ; Check for any RG, OT or CT in Tour 2
. . . ;
. . . I TOURS="TOUR2",("123678"[CODE!(CODE="")) D
. . . . S CODE=$S(CODE="":3,"3568"[CODE:3,CODE=1:5,CODE=2:6,1:9)
. . . . S CODE2=$S(CODE=5:3,CODE=6:3,1:4)
. . . ;
. . . ; Check for any Unscheduled Regular (RG), OT, CT in
. . . ; the Exceptions
. . . ;
. . . I TOURS="EXCEPT",("^RG^OT^CT^"[("^"_CODE_"^")) D
. . . . S CODE=$S(CODE="RG":4,CODE="OT":5,CODE="CT":6,1:9)
. . . . S CODE2=$S(CODE=5:3,CODE=6:3,1:4)
. . . ;
. . . ; Check for any approved type of leave
. . . ;
. . . I TOURS="EXCEPT",("^AA^AD^AL^CB^CU^DL^HX^ML^NL^NP^RL^SL^TV^UN^WP^"[("^"_CODE_"^")) D
. . . . S CODE=$S("^AA^AD^AL^CB^CU^DL^HX^ML^NL^NP^RL^SL^TV^UN^WP^"[("^"_CODE_"^"):3,1:9)
. . . . S ADDSUB=-1
. . . . ;
. . . . ; Was the leave for the whole day?
. . . . ;
. . . . S TOUR=$P(TOUR1,U,SEG,SEG+1)
. . . . I START_"^"_END=TOUR D
. . . . . S HRSWRK=$P(TINFO,U,8)*ADDSUB,ALLTOUR=1
. . . ;
. . . ; Quit if invalid code
. . . ;
. . . Q:CODE>8
. . . ;
. . . ; Calculate how much time to add or subtract and store value
. . . ;
. . . I ALLTOUR'=1 D
. . . . S X=START_"^"_END
. . . . D CNV^PRSATIM
. . . . I $P(Y,U,2)<$P(Y,U,1) S $P(Y,"^",2)=$P(Y,"^",2)+1440
. . . . S HRSWRK=(($P(Y,U,2)-$P(Y,U,1))/60)*ADDSUB
. . . S $P(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA),U,CODE)=$P($G(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,CODE)+HRSWRK
. . . I PP>25&(YEAR="00")!(PP<25&(YEAR="01")) D
. . . . ;
. . . . ; Don't track approved leave or unscheduled regular for
. . . . ; report # 2
. . . . ;
. . . . Q:HRSWRK<0!(CODE2'=3)
. . . . S $P(^TMP($J,"RPT2",SSN,OCC,VISN,STA),U,CODE2)=$P($G(^TMP($J,"RPT2",SSN,OCC,VISN,STA)),U,CODE2)+HRSWRK
. . . I 'COUNTED D
. . . . S $P(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA),U,1)=$P($G(^TMP($J,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,1)+1
. . . . I PP>25&(YEAR="00")!(PP<25&(YEAR="01")) D
. . . . . S $P(^TMP($J,"RPT2",SSN,OCC,VISN,STA),U,1)=$P($G(^TMP($J,"RPT2",SSN,OCC,VISN,STA)),U,1)+1
. . . . S COUNTED=1
K Y
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP79 8564 printed Apr 09, 2024@21:27 Page 2
PRSXP79 ;WCIOFO/MGD-MANDATORY HOURS REPORT ;08/14/2002
+1 ;;4.0;PAID;**79**;Sep 21, 1995
+2 ;
+3 QUIT
+4 ;
+5 ; This program will create a report on the number of Normal Hours
+6 ; Unscheduled Hours, Overtime Hours and Compensatory Hours worked
+7 ; by nurses from the years 1997 through 2001.
+8 ;
+9 ; This program is read only and will not alter any VistA/PAID data.
+10 ;
+11 ; For more details see the patch description on FORUM.
+12 ;
START ; Main Driver
+1 ;
+2 KILL ^TMP($JOB),TMP
+3 NEW STANUM,TMP,U
+4 SET U="^"
+5 WRITE !!,"This report may take over an hour to run."
+6 DO NOW^%DTC
+7 SET Y=%
+8 DO DD^%DT
+9 WRITE !!,Y
+10 WRITE !,">>>> Starting to compile reports.",!!
+11 ;
+12 ; Get Station Number
+13 ;
+14 SET STANUM=$$KSP^XUPARAM("INST")_","
+15 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+16 ;
+17 DO RPT
+18 WRITE !!,">>>> Reports completed. Mail messages sent."
+19 DO NOW^%DTC
+20 SET Y=%
+21 DO DD^%DT
+22 WRITE !,Y
+23 KILL %,TMP,^TMP($JOB),Y
+24 QUIT
+25 ;----------------------------------------------------------------;
RPT ; Reports ;
+1 ;----------------------------------------------------------------;
+2 ;
+3 NEW OCC,DATA0,EMP,PRS,SSN,STA,VISN
+4 ;
+5 ; Create Temporary Global listing of employees with OCCUPATION SERIES
+6 ; & TITLE Codes beginning with 0605,0610,0620 and 0621
+7 ;
EMP SET EMP=0
+1 FOR
SET EMP=$ORDER(^PRSPC(EMP))
if 'EMP
QUIT
Begin DoDot:1
+2 SET DATA0=$GET(^PRSPC(EMP,0))
+3 if DATA0=""
QUIT
+4 SET OCC=$EXTRACT($PIECE(DATA0,U,17),1,4)
+5 IF OCC="0605"!(OCC="0610")!(OCC="0620")!(OCC="0621")
Begin DoDot:2
+6 SET SSN=$PIECE(DATA0,U,34)
+7 IF SSN=""
SET SSN=$PIECE(DATA0,U,9)
+8 if SSN=""
QUIT
+9 SET STA=+$PIECE(DATA0,U,7)
+10 if 'STA
QUIT
+11 ;
+12 ; Get the VISN number from the employee's STATION NUMBER (#6)
+13 ;
+14 DO PARENT^XUAF4("PRS",STA,"VISN")
+15 SET (PRS,VISN)=""
+16 SET PRS=$ORDER(PRS("P",PRS))
+17 if 'PRS
QUIT
+18 SET VISN=$PIECE(PRS("P",PRS),U,1)
+19 if VISN=""
QUIT
+20 SET ^TMP($JOB,OCC,EMP)=SSN_"^"_VISN_"^"_STA
End DoDot:2
End DoDot:1
+21 if '$DATA(^TMP($JOB))
QUIT
+22 ;
+23 ; Get IEN for year in files
+24 ;
IEN NEW IEN458,IEN459,PP,PRSD,XPDIDTOT,YEAR
+1 ; # of pay period processed
SET PRSD("TOT")=131
+2 ; # of Items Evaluated
SET PRSD("IE")=0
+3 ; Set total for Status Bar
SET XPDIDTOT=PRSD("TOT")
+4 ; Initial % required to update Status Bar
SET PRSD("UPD")=5
+5 FOR YEAR=97,98,99,"00","01"
Begin DoDot:1
+6 FOR PP="01","02","03","04","05","06","07","08","09",10:1:27
Begin DoDot:2
+7 ;
+8 ; The following code will update the % Complete Status Bar
+9 ; during the installation of the patch.
+10 ;
+11 SET PRSD("IE")=PRSD("IE")+1
+12 ; Calculate % complete
SET PRSD("%")=PRSD("IE")*100/PRSD("TOT")
+13 ;
+14 ; Check if Status Bar should be updated
+15 ;
+16 IF PRSD("%")>PRSD("UPD")
Begin DoDot:3
+17 ; Update Status Bar
DO UPDATE^XPDID(PRSD("IE"))
+18 ; Increase update criteria by 5%
SET PRSD("UPD")=PRSD("UPD")+5
End DoDot:3
+19 ;
+20 ; Get IEN for the TIME & ATTENDANCE RECORDS (#458) file
+21 SET IEN458=""
+22 SET IEN458=$ORDER(^PRST(458,"B",YEAR_"-"_PP,IEN458))
+23 if 'IEN458
QUIT
+24 ;
+25 ; Get IEN for the PAID PAYRUN DATA (#459) file
+26 ;
+27 SET IEN459=""
+28 SET IEN459=$ORDER(^PRST(459,"B",YEAR_"-"_PP,IEN459))
+29 if 'IEN459
QUIT
+30 DO GETDATA
End DoDot:2
End DoDot:1
+31 DO STORE^PRSXP79A
+32 DO XMIT^PRSXP79A
+33 QUIT
+34 ;
GETDATA ; Loop through OCC codes checking for data in the TIME & ATTENDANCE
+1 ; RECORDS (#458) and PAID PAYRUN DATA (#459) files.
+2 ;
+3 NEW ZERO459,DATA
+4 FOR OCC="0605","0610","0620","0621"
Begin DoDot:1
+5 SET EMP=""
+6 FOR
SET EMP=$ORDER(^TMP($JOB,OCC,EMP))
if 'EMP
QUIT
Begin DoDot:2
+7 ;
+8 ; Load SSN, VISN and STA
+9 ;
+10 SET DATA=$GET(^TMP($JOB,OCC,EMP))
+11 if DATA=""
QUIT
+12 SET SSN=$PIECE(DATA,U,1)
SET VISN=$PIECE(DATA,U,2)
SET STA=$PIECE(DATA,U,3)
+13 if SSN=""!(VISN="")!(STA="")
QUIT
+14 ;
+15 ; Quit if they didn't have an entry in the TIME & ATTENDANCE
+16 ; RECORDS (#458) file for the pay period in question
+17 ;
+18 if '$DATA(^PRST(458,IEN458,"E",EMP,0))
QUIT
+19 ;
+20 ; Quit if they didn't have an entry in the PAID PAYRUN DATA (#459)
+21 ; file for the pay period in question
+22 ;
+23 SET ZERO459=$GET(^PRST(459,IEN459,"P",EMP,0))
+24 if ZERO459=""
QUIT
+25 ;
+26 ; Quit if the employee was Intermittent during the pay period
+27 ; in question
+28 ;
+29 if $PIECE(ZERO459,U,6)=3
QUIT
+30 ;
+31 ; Verify that the employee's SUBACCT CODE (#8) during the pay
+32 ; period in question corresponds to one of the SUBACCT CODEs
+33 ; assigned to nurses (i.e. 60 - 67)
+34 ;
+35 if $PIECE(ZERO459,U,9)<60&($PIECE(ZERO459,U,9)>67)
QUIT
+36 ;
+37 DO REVDAY
End DoDot:2
End DoDot:1
+38 QUIT
REVDAY ; Review each day in the pay period to determine if any work
+1 ; was performed
+2 NEW COUNTED,DAY,EXCEPT,TINFO,TOUR1,TOUR2,TOURS,YR
+3 SET COUNTED=0
+4 FOR DAY=1:1:14
Begin DoDot:1
+5 SET TINFO=$GET(^PRST(458,IEN458,"E",EMP,"D",DAY,0))
+6 SET TOUR1=$GET(^PRST(458,IEN458,"E",EMP,"D",DAY,1))
+7 SET TOUR2=$GET(^PRST(458,IEN458,"E",EMP,"D",DAY,4))
+8 SET EXCEPT=$GET(^PRST(458,IEN458,"E",EMP,"D",DAY,2))
+9 ;
+10 ; Quit if no data for any tour or exception
+11 ;
+12 if TOUR1=""&(TOUR2="")&(EXCEPT="")
QUIT
+13 ;
+14 ; Quit if it is the employee's day off and there are no exceptions
+15 ;
+16 if $PIECE(TINFO,U,2)=1&(TOUR2="")&(EXCEPT="")
QUIT
+17 ;
+18 ; Record Normal Hours scheduled to work
+19 ;
+20 IF $PIECE(TINFO,U,2)'=1
Begin DoDot:2
+21 ;
+22 ; Update Normal Hours worked for report # 1
+23 ;
+24 SET $PIECE(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA),U,3)=$PIECE($GET(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,3)+$PIECE(TINFO,U,8)
+25 ;
+26 ; Check if it is the last pay period of the year
+27 ;
+28 IF PP=26
SET $PIECE(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA),U,2)="Y"
+29 IF PP>25&(YEAR="00")!(PP<25&(YEAR="01"))
Begin DoDot:3
+30 SET $PIECE(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA),U,2)="Y"
End DoDot:3
+31 ;
+32 ; Update employee count
+33 ;
+34 IF 'COUNTED
Begin DoDot:3
+35 SET $PIECE(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA),U,1)=$PIECE($GET(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,1)+1
+36 IF PP>25&(YEAR="00")!(PP<25&(YEAR="01"))
Begin DoDot:4
+37 SET $PIECE(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA),U,1)=$PIECE($GET(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA)),U,1)+1
End DoDot:4
+38 SET COUNTED=1
End DoDot:3
End DoDot:2
+39 ;
+40 ; Quit if there is no second tour or exceptions
+41 ;
+42 if TOUR2=""&(EXCEPT="")
QUIT
+43 ;
+44 ; Otherwise check Tour 2 and the exceptions for other types of time
+45 ; to include in the report. Then check the exceptions for any types
+46 ; of approved leave that would remove hours from the report.
+47 ;
+48 FOR TOURS="TOUR2","EXCEPT"
Begin DoDot:2
+49 ;
SEG ; Loop through segments of tour or exception
+1 ;
+2 NEW ADDSUB,ALLTOUR,CODE,CODE2,END,HRSWRK,SEG,START,TOUR,X
+3 if @TOURS=""
QUIT
+4 FOR SEG=1:4:21
Begin DoDot:3
+5 SET (ALLTOUR,TOUR)=0
+6 SET START=$PIECE(@TOURS,U,SEG)
+7 SET END=$PIECE(@TOURS,U,SEG+1)
+8 SET CODE=$PIECE(@TOURS,U,SEG+2)
+9 SET CODE2=4
+10 SET ADDSUB=1
+11 ;
+12 ; Quit if the start or stop time is missing
+13 ;
+14 if START=""!(END="")
QUIT
+15 ;
+16 ; Check for any RG, OT or CT in Tour 2
+17 ;
+18 IF TOURS="TOUR2"
IF ("123678"[CODE!(CODE=""))
Begin DoDot:4
+19 SET CODE=$SELECT(CODE="":3,"3568"[CODE:3,CODE=1:5,CODE=2:6,1:9)
+20 SET CODE2=$SELECT(CODE=5:3,CODE=6:3,1:4)
End DoDot:4
+21 ;
+22 ; Check for any Unscheduled Regular (RG), OT, CT in
+23 ; the Exceptions
+24 ;
+25 IF TOURS="EXCEPT"
IF ("^RG^OT^CT^"[("^"_CODE_"^"))
Begin DoDot:4
+26 SET CODE=$SELECT(CODE="RG":4,CODE="OT":5,CODE="CT":6,1:9)
+27 SET CODE2=$SELECT(CODE=5:3,CODE=6:3,1:4)
End DoDot:4
+28 ;
+29 ; Check for any approved type of leave
+30 ;
+31 IF TOURS="EXCEPT"
IF ("^AA^AD^AL^CB^CU^DL^HX^ML^NL^NP^RL^SL^TV^UN^WP^"[("^"_CODE_"^"))
Begin DoDot:4
+32 SET CODE=$SELECT("^AA^AD^AL^CB^CU^DL^HX^ML^NL^NP^RL^SL^TV^UN^WP^"[("^"_CODE_"^"):3,1:9)
+33 SET ADDSUB=-1
+34 ;
+35 ; Was the leave for the whole day?
+36 ;
+37 SET TOUR=$PIECE(TOUR1,U,SEG,SEG+1)
+38 IF START_"^"_END=TOUR
Begin DoDot:5
+39 SET HRSWRK=$PIECE(TINFO,U,8)*ADDSUB
SET ALLTOUR=1
End DoDot:5
End DoDot:4
+40 ;
+41 ; Quit if invalid code
+42 ;
+43 if CODE>8
QUIT
+44 ;
+45 ; Calculate how much time to add or subtract and store value
+46 ;
+47 IF ALLTOUR'=1
Begin DoDot:4
+48 SET X=START_"^"_END
+49 DO CNV^PRSATIM
+50 IF $PIECE(Y,U,2)<$PIECE(Y,U,1)
SET $PIECE(Y,"^",2)=$PIECE(Y,"^",2)+1440
+51 SET HRSWRK=(($PIECE(Y,U,2)-$PIECE(Y,U,1))/60)*ADDSUB
End DoDot:4
+52 SET $PIECE(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA),U,CODE)=$PIECE($GET(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,CODE)+HRSWRK
+53 IF PP>25&(YEAR="00")!(PP<25&(YEAR="01"))
Begin DoDot:4
+54 ;
+55 ; Don't track approved leave or unscheduled regular for
+56 ; report # 2
+57 ;
+58 if HRSWRK<0!(CODE2'=3)
QUIT
+59 SET $PIECE(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA),U,CODE2)=$PIECE($GET(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA)),U,CODE2)+HRSWRK
End DoDot:4
+60 IF 'COUNTED
Begin DoDot:4
+61 SET $PIECE(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA),U,1)=$PIECE($GET(^TMP($JOB,"RPT1",SSN,YEAR,OCC,VISN,STA)),U,1)+1
+62 IF PP>25&(YEAR="00")!(PP<25&(YEAR="01"))
Begin DoDot:5
+63 SET $PIECE(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA),U,1)=$PIECE($GET(^TMP($JOB,"RPT2",SSN,OCC,VISN,STA)),U,1)+1
End DoDot:5
+64 SET COUNTED=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+65 KILL Y
+66 QUIT
+67 ;
