- 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 Feb 18, 2025@23:55:33 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 ;