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

PRSXP79.m

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