- PRSAOTTW ;WCIOFO/JAH-OVERTIME WARNINGS (OTW) LISTER--8/18/98
- ;;4.0;PAID;**43**;Sep 21, 1995
- ; = = = = = = = = = = = = = = = = =
- ;
- LISTEN ; -- main entry point for OTW LIST--called by list manager
- ;
- S PRSOUT=0
- D LISPARAM(.PRSWPP,.PRSWPPI,.PRSWSTAT,.PRSOUT)
- Q:PRSOUT
- ;convert status to internal value in ot warnings file
- ; A = active i = inactive (b for both is not an internal status)
- S PRSWSTAT=$S(PRSWSTAT=1:"A",PRSWSTAT=2:"C",1:"B")
- ;
- ; Call to List Manager to run PRSA OVERTIME WARNINGS template
- D EN^VALM("PRSA OVERTIME WARNINGS")
- Q
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- LISPARAM(PP,PPI,STAT,USEROUT) ;
- ;Ask the user if they want the list to contain 1 or all pay peroids
- ;and whether they want to see cleared, active or all warnings.
- N DIR,DIRUT,X,Y
- S USEROUT=0
- S DIR(0)="S^1:select a pay period;2:all pay periods"
- D ^DIR S PP=Y
- I $D(DIRUT) S USEROUT=1 Q
- ;
- ; get pp if user chose a single pp
- I PP=1 D
- . S DIC="^PRST(458,",DIC(0)="AEMNQ" D ^DIC
- . S PPI=+Y
- ;
- ;Prompt user for type of warnings to display
- I Y'>0 S USEROUT=1 Q
- N DIR,X,Y,DIRUT
- S DIR(0)="S^1:Active Warnings;2:Cleared Warnings;3:Active & Cleared"
- D BLDHLP,^DIR
- I $D(DIRUT) S USEROUT=1 Q
- S STAT=Y
- Q
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- BLDHLP ;
- N I,TXT
- S DIR("?")=" Enter 1, 2, 3 or '^' to exit."
- F I=1:1 S TXT=$P($T(HLPTXT+I),";;",2) Q:TXT="" S DIR("?",I)=TXT
- Q
- HLPTXT ;
- ;; Overtime Warnings occur when an employee has more
- ;; overtime in their TT8B string than approved overtime in the
- ;; overtime requests file. Normally, a warning becomes ACTIVE when a
- ;; timecard is certified that will result in unapproved overtime
- ;; being paid. If corrective action is taken payroll may then
- ;; CLEAR the overtime warning. Although CLEARED warnings may be
- ;; viewed through this option they WILL NO LONGER appear on the Pay
- ;; Period Exceptions report. ACTIVE warnings will appear on the
- ;; exceptions report.
- ;;
- Q
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- HDR ; -- header code
- ; All pperiods.
- I PRSWPP=2 D
- . I PRSWSTAT="C" S VALMHDR(1)="Cleared for all pay periods"
- . I PRSWSTAT="A" S VALMHDR(1)="Active for all pay periods"
- . I PRSWSTAT="B" S VALMHDR(1)="Active & cleared for all pay periods."
- ;
- I PRSWPP=1 D
- . I PRSWSTAT="C" S VALMHDR(1)="Cleared for single pay period"
- . I PRSWSTAT="A" S VALMHDR(1)="Active for single pay period"
- . I PRSWSTAT="B" S VALMHDR(1)="Active & cleared for a single pay period"
- Q
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- INIT ; -- init variables and list array
- ; This entry point is called from list manager
- ;
- N IEN,PPE,WK,OT8B,OTAP,COUNT
- S U="^"
- K ^TMP("PRSAOTW",$J)
- S LIST=0,NUMBER=0
- D CLEAN^VALM10
- S COUNT=0,NUMBER=""
- ;
- ;loop adds list items if user chose active OR inactive & all pperiods.
- I PRSWPP=2,PRSWSTAT'="B" D
- .F S NUMBER=$O(^PRST(458.6,"E",PRSWSTAT,NUMBER)) Q:NUMBER="" D
- .. D LISITEM(NUMBER,.COUNT)
- ;
- ;loop adds list items if user chose active OR inactive & 1 pperiod
- ;
- I PRSWPP=1,PRSWSTAT'="B" D
- .S NUMBER=0
- .F S NUMBER=$O(^PRST(458.6,"C",PRSWPPI,NUMBER)) Q:NUMBER="" D
- .. I $D(^PRST(458.6,"E",PRSWSTAT,NUMBER)) D LISITEM(NUMBER,.COUNT)
- ;
- ;loop adds list items if user chose active & inactive & 1 pperiod
- ;
- I PRSWPP=1,PRSWSTAT="B" D
- .S NUMBER=0
- .F S NUMBER=$O(^PRST(458.6,"C",PRSWPPI,NUMBER)) Q:NUMBER="" D
- .. D LISITEM(NUMBER,.COUNT)
- ;
- ;loop adds list items if user chose active & inactive & all pperiods.
- ;
- I PRSWPP=2,PRSWSTAT="B" D
- .;1st loop through 4 digit year pp x-ref
- .S PRSWPPI=""
- .F S PRSWPPI=$O(^PRST(458.6,"D",PRSWPPI)) Q:PRSWPPI']"" D
- .. S NUMBER=0
- .. F S NUMBER=$O(^PRST(458.6,"D",PRSWPPI,NUMBER)) Q:NUMBER'>0 D
- ... D LISITEM(NUMBER,.COUNT)
- ;
- S VALMCNT=COUNT
- Q
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- LISITEM(IEN,COUNT) ;ADD A SINGLE ITEM TO OT WARNINGS LIST
- N PPI,PPE,EMP,WK,OT8B,OTAP,STAT,TL,CLEARER
- S COUNT=COUNT+1
- ;
- ;get fields from a record in the ot warnings file
- ;
- S PPI=$P($G(^PRST(458.6,IEN,0)),U,3) ; Pay per ien
- S PPE=$P($G(^PRST(458,PPI,0)),U) ; pay per ext format
- S EMP=$P($G(^PRST(458.6,IEN,0)),U,2) ; employee ien in 450
- S EMP=$P($G(^PRSPC(EMP,0)),U),TL=$P(^(0),U,8) ; name and t&l unit
- S WK=$P($G(^PRST(458.6,IEN,0)),U,4) ; week 1 or 2 of pay per
- S OT8B=" "_$P($G(^PRST(458.6,IEN,0)),U,8) ; all ot in 8b string
- S OTAP=" "_$P($G(^PRST(458.6,IEN,0)),U,9) ; all ot in request file
- S STAT=$P($G(^PRST(458.6,IEN,0)),U,5) ; status of warning
- S STAT=$S(STAT="A":"Active",1:"Cleared")
- S CLEARER=$P($G(^PRST(458.6,IEN,0)),U,6) ; clearer 450 IEN
- I CLEARER S CLEARER=$P($G(^VA(200,CLEARER,0)),U) ; clearer 450 name
- ;
- ;Build one line (X) for list manager containing a warning.
- ; 3rd parameter is name of field on List Template
- ;
- S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
- S X=$$SETFLD^VALM1(PPE,X,"PAY PERIOD")
- S X=$$SETFLD^VALM1(WK,X,"WEEK")
- S X=$$SETFLD^VALM1(EMP,X,"EMPLOYEE")
- S X=$$SETFLD^VALM1(TL,X,"TL")
- S X=$$SETFLD^VALM1(STAT,X,"STATUS")
- S X=$$SETFLD^VALM1(OT8B,X,"OT8B")
- S X=$$SETFLD^VALM1(OTAP,X,"OTAP")
- S X=$$SETFLD^VALM1(CLEARER,X,"UPDATER")
- D SET^VALM10(COUNT,X,COUNT)
- ;
- ; save the ien of the record in the list global for easier
- ; reference to the acutal data.
- ;
- S ^TMP("PRSAOTW",$J,COUNT)=IEN
- Q
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- PRSIEN() ;RETURN PAID IEN FROM 450 BASED ON DUZ.
- N SSN
- ;
- S PRSIEN=""
- Q:'DUZ PRSIEN
- ;
- S SSN=$P($G(^VA(200,DUZ,1)),"^",9)
- I SSN'="" S PRSIEN=$O(^PRSPC("SSN",SSN,0)) S:PRSIEN'>0 PRSIEN=""
- Q PRSIEN
- ;
- ; = = = = = = = = = = = = = = = = =
- ;
- CLEAR ; Clear an OT warning. This code called when a user running the
- ; OT warnings option selects clear OT warnings protocol.
- ;
- N PRSCREC,PRSCLCNT,PRSELECT,PRSNOCL,DIE,DIR,DIRUT,PLURAL
- ;
- ;allow selection of list items in the display region.
- ;
- D EN^VALM2("","")
- Q:$O(VALMY(0))'>0
- ;
- S PRSCLCNT=0,DIE="^PRST(458.6,"
- S (PRSCREC,PRSELECT,PRSNOCL)=""
- F S PRSCREC=$O(VALMY(PRSCREC)) Q:PRSCREC="" D
- . ;
- . ;Get ien for 458.6 that matches the list item.
- . S PRSCIEN=$G(^TMP("PRSAOTW",$J,PRSCREC))
- . ;
- . ;Get status of ot warning
- . S PRSCSTAT=$P($G(^PRST(458.6,PRSCIEN,0)),U,5)
- . ;
- . ;increment clearable warning count
- . ;& build variable of items that will be cleared
- . ;& highlight selected items
- . I PRSCSTAT="A" D
- .. S PRSCLCNT=PRSCLCNT+1,PRSELECT=PRSELECT_","_PRSCREC
- .. ;
- .. D CNTRL^VALM10(PRSCREC,2,$L(PRSCREC),IORVON,IORVOFF)
- .. D CNTRL^VALM10(PRSCREC,5,74,IOINHI,IOINORM),WRITE^VALM10(PRSCREC)
- ;
- ;strip off leading comma from clear list
- S PRSELECT=$P(PRSELECT,",",2,999)
- ;
- ;return to list if no active warnings selected.
- ;
- I PRSELECT="" S VALMSG="No ACTIVE warnings selected." S VALMBCK="R" Q
- ;
- ; If user wants to clear items then clear all selected. Skip any
- ; that r already clear & keep track of any that are locked (PRSNOCL).
- ; Build ListMan message w/ all unclearable records due to locks.
- ;
- S DIR(0)="YA"
- S PLURAL=$S($L(PRSELECT,",")<2:"entry",1:"entries")
- S DIR("A")="Clear "_PLURAL_" "_PRSELECT_" ?"
- D ^DIR
- I Y D
- . S PRSCREC=0
- . F S PRSCREC=$O(VALMY(PRSCREC)) Q:PRSCREC="" D
- .. S PRSCIEN=$G(^TMP("PRSAOTW",$J,PRSCREC))
- .. S PRSCSTAT=$P($G(^PRST(458.6,PRSCIEN,0)),U,5)
- .. I PRSCSTAT="A" D
- ... S PRSCSTAT="C"
- ... S DR="4///^S X=PRSCSTAT",DA=PRSCIEN
- ... L +^PRST(458.6,PRSCIEN):0
- ... I $T D
- .... D ^DIE L -^PRST(458.6,PRSCIEN)
- ... E S PRSNOCL=PRSNOCL_" "_PRSCREC
- S:PRSNOCL'="" VALMSG=PRSNOCL_" NOT CLEARED. EDIT BY ANOTHER USER"
- ;
- ;whether list items cleared or not rebuild list and return
- ;
- D INIT
- S VALMBCK="R"
- Q
- HELP ;Help for the PRSA OVERTIME WARNINGS list template
- D FULL^VALM1
- W !!,?2,"At the Action prompt you may enter CL or VI.",!
- W !,?4,"Enter CL to select any of the active overtime warnings on the"
- W !,?4,"screen that you wish to clear.",!
- W !,?4,"Enter VI to select one of the displayed warnings to view requests"
- W !,?4,"on file that correlate to the week and pay period of the warning."
- D PAUSE^VALM1
- D RE^VALM4
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAOTTW 8312 printed Jan 18, 2025@03:24:59 Page 2
- PRSAOTTW ;WCIOFO/JAH-OVERTIME WARNINGS (OTW) LISTER--8/18/98
- +1 ;;4.0;PAID;**43**;Sep 21, 1995
- +2 ; = = = = = = = = = = = = = = = = =
- +3 ;
- LISTEN ; -- main entry point for OTW LIST--called by list manager
- +1 ;
- +2 SET PRSOUT=0
- +3 DO LISPARAM(.PRSWPP,.PRSWPPI,.PRSWSTAT,.PRSOUT)
- +4 if PRSOUT
- QUIT
- +5 ;convert status to internal value in ot warnings file
- +6 ; A = active i = inactive (b for both is not an internal status)
- +7 SET PRSWSTAT=$SELECT(PRSWSTAT=1:"A",PRSWSTAT=2:"C",1:"B")
- +8 ;
- +9 ; Call to List Manager to run PRSA OVERTIME WARNINGS template
- +10 DO EN^VALM("PRSA OVERTIME WARNINGS")
- +11 QUIT
- +12 ;
- +13 ; = = = = = = = = = = = = = = = = =
- +14 ;
- LISPARAM(PP,PPI,STAT,USEROUT) ;
- +1 ;Ask the user if they want the list to contain 1 or all pay peroids
- +2 ;and whether they want to see cleared, active or all warnings.
- +3 NEW DIR,DIRUT,X,Y
- +4 SET USEROUT=0
- +5 SET DIR(0)="S^1:select a pay period;2:all pay periods"
- +6 DO ^DIR
- SET PP=Y
- +7 IF $DATA(DIRUT)
- SET USEROUT=1
- QUIT
- +8 ;
- +9 ; get pp if user chose a single pp
- +10 IF PP=1
- Begin DoDot:1
- +11 SET DIC="^PRST(458,"
- SET DIC(0)="AEMNQ"
- DO ^DIC
- +12 SET PPI=+Y
- End DoDot:1
- +13 ;
- +14 ;Prompt user for type of warnings to display
- +15 IF Y'>0
- SET USEROUT=1
- QUIT
- +16 NEW DIR,X,Y,DIRUT
- +17 SET DIR(0)="S^1:Active Warnings;2:Cleared Warnings;3:Active & Cleared"
- +18 DO BLDHLP
- DO ^DIR
- +19 IF $DATA(DIRUT)
- SET USEROUT=1
- QUIT
- +20 SET STAT=Y
- +21 QUIT
- +22 ;
- +23 ; = = = = = = = = = = = = = = = = =
- +24 ;
- BLDHLP ;
- +1 NEW I,TXT
- +2 SET DIR("?")=" Enter 1, 2, 3 or '^' to exit."
- +3 FOR I=1:1
- SET TXT=$PIECE($TEXT(HLPTXT+I),";;",2)
- if TXT=""
- QUIT
- SET DIR("?",I)=TXT
- +4 QUIT
- HLPTXT ;
- +1 ;; Overtime Warnings occur when an employee has more
- +2 ;; overtime in their TT8B string than approved overtime in the
- +3 ;; overtime requests file. Normally, a warning becomes ACTIVE when a
- +4 ;; timecard is certified that will result in unapproved overtime
- +5 ;; being paid. If corrective action is taken payroll may then
- +6 ;; CLEAR the overtime warning. Although CLEARED warnings may be
- +7 ;; viewed through this option they WILL NO LONGER appear on the Pay
- +8 ;; Period Exceptions report. ACTIVE warnings will appear on the
- +9 ;; exceptions report.
- +10 ;;
- +11 QUIT
- +12 ;
- +13 ; = = = = = = = = = = = = = = = = =
- +14 ;
- HDR ; -- header code
- +1 ; All pperiods.
- +2 IF PRSWPP=2
- Begin DoDot:1
- +3 IF PRSWSTAT="C"
- SET VALMHDR(1)="Cleared for all pay periods"
- +4 IF PRSWSTAT="A"
- SET VALMHDR(1)="Active for all pay periods"
- +5 IF PRSWSTAT="B"
- SET VALMHDR(1)="Active & cleared for all pay periods."
- End DoDot:1
- +6 ;
- +7 IF PRSWPP=1
- Begin DoDot:1
- +8 IF PRSWSTAT="C"
- SET VALMHDR(1)="Cleared for single pay period"
- +9 IF PRSWSTAT="A"
- SET VALMHDR(1)="Active for single pay period"
- +10 IF PRSWSTAT="B"
- SET VALMHDR(1)="Active & cleared for a single pay period"
- End DoDot:1
- +11 QUIT
- +12 ;
- +13 ; = = = = = = = = = = = = = = = = =
- +14 ;
- INIT ; -- init variables and list array
- +1 ; This entry point is called from list manager
- +2 ;
- +3 NEW IEN,PPE,WK,OT8B,OTAP,COUNT
- +4 SET U="^"
- +5 KILL ^TMP("PRSAOTW",$JOB)
- +6 SET LIST=0
- SET NUMBER=0
- +7 DO CLEAN^VALM10
- +8 SET COUNT=0
- SET NUMBER=""
- +9 ;
- +10 ;loop adds list items if user chose active OR inactive & all pperiods.
- +11 IF PRSWPP=2
- IF PRSWSTAT'="B"
- Begin DoDot:1
- +12 FOR
- SET NUMBER=$ORDER(^PRST(458.6,"E",PRSWSTAT,NUMBER))
- if NUMBER=""
- QUIT
- Begin DoDot:2
- +13 DO LISITEM(NUMBER,.COUNT)
- End DoDot:2
- End DoDot:1
- +14 ;
- +15 ;loop adds list items if user chose active OR inactive & 1 pperiod
- +16 ;
- +17 IF PRSWPP=1
- IF PRSWSTAT'="B"
- Begin DoDot:1
- +18 SET NUMBER=0
- +19 FOR
- SET NUMBER=$ORDER(^PRST(458.6,"C",PRSWPPI,NUMBER))
- if NUMBER=""
- QUIT
- Begin DoDot:2
- +20 IF $DATA(^PRST(458.6,"E",PRSWSTAT,NUMBER))
- DO LISITEM(NUMBER,.COUNT)
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 ;loop adds list items if user chose active & inactive & 1 pperiod
- +23 ;
- +24 IF PRSWPP=1
- IF PRSWSTAT="B"
- Begin DoDot:1
- +25 SET NUMBER=0
- +26 FOR
- SET NUMBER=$ORDER(^PRST(458.6,"C",PRSWPPI,NUMBER))
- if NUMBER=""
- QUIT
- Begin DoDot:2
- +27 DO LISITEM(NUMBER,.COUNT)
- End DoDot:2
- End DoDot:1
- +28 ;
- +29 ;loop adds list items if user chose active & inactive & all pperiods.
- +30 ;
- +31 IF PRSWPP=2
- IF PRSWSTAT="B"
- Begin DoDot:1
- +32 ;1st loop through 4 digit year pp x-ref
- +33 SET PRSWPPI=""
- +34 FOR
- SET PRSWPPI=$ORDER(^PRST(458.6,"D",PRSWPPI))
- if PRSWPPI']""
- QUIT
- Begin DoDot:2
- +35 SET NUMBER=0
- +36 FOR
- SET NUMBER=$ORDER(^PRST(458.6,"D",PRSWPPI,NUMBER))
- if NUMBER'>0
- QUIT
- Begin DoDot:3
- +37 DO LISITEM(NUMBER,.COUNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +38 ;
- +39 SET VALMCNT=COUNT
- +40 QUIT
- +41 ;
- +42 ; = = = = = = = = = = = = = = = = =
- +43 ;
- LISITEM(IEN,COUNT) ;ADD A SINGLE ITEM TO OT WARNINGS LIST
- +1 NEW PPI,PPE,EMP,WK,OT8B,OTAP,STAT,TL,CLEARER
- +2 SET COUNT=COUNT+1
- +3 ;
- +4 ;get fields from a record in the ot warnings file
- +5 ;
- +6 ; Pay per ien
- SET PPI=$PIECE($GET(^PRST(458.6,IEN,0)),U,3)
- +7 ; pay per ext format
- SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U)
- +8 ; employee ien in 450
- SET EMP=$PIECE($GET(^PRST(458.6,IEN,0)),U,2)
- +9 ; name and t&l unit
- SET EMP=$PIECE($GET(^PRSPC(EMP,0)),U)
- SET TL=$PIECE(^(0),U,8)
- +10 ; week 1 or 2 of pay per
- SET WK=$PIECE($GET(^PRST(458.6,IEN,0)),U,4)
- +11 ; all ot in 8b string
- SET OT8B=" "_$PIECE($GET(^PRST(458.6,IEN,0)),U,8)
- +12 ; all ot in request file
- SET OTAP=" "_$PIECE($GET(^PRST(458.6,IEN,0)),U,9)
- +13 ; status of warning
- SET STAT=$PIECE($GET(^PRST(458.6,IEN,0)),U,5)
- +14 SET STAT=$SELECT(STAT="A":"Active",1:"Cleared")
- +15 ; clearer 450 IEN
- SET CLEARER=$PIECE($GET(^PRST(458.6,IEN,0)),U,6)
- +16 ; clearer 450 name
- IF CLEARER
- SET CLEARER=$PIECE($GET(^VA(200,CLEARER,0)),U)
- +17 ;
- +18 ;Build one line (X) for list manager containing a warning.
- +19 ; 3rd parameter is name of field on List Template
- +20 ;
- +21 SET X=$$SETFLD^VALM1(COUNT,"","NUMBER")
- +22 SET X=$$SETFLD^VALM1(PPE,X,"PAY PERIOD")
- +23 SET X=$$SETFLD^VALM1(WK,X,"WEEK")
- +24 SET X=$$SETFLD^VALM1(EMP,X,"EMPLOYEE")
- +25 SET X=$$SETFLD^VALM1(TL,X,"TL")
- +26 SET X=$$SETFLD^VALM1(STAT,X,"STATUS")
- +27 SET X=$$SETFLD^VALM1(OT8B,X,"OT8B")
- +28 SET X=$$SETFLD^VALM1(OTAP,X,"OTAP")
- +29 SET X=$$SETFLD^VALM1(CLEARER,X,"UPDATER")
- +30 DO SET^VALM10(COUNT,X,COUNT)
- +31 ;
- +32 ; save the ien of the record in the list global for easier
- +33 ; reference to the acutal data.
- +34 ;
- +35 SET ^TMP("PRSAOTW",$JOB,COUNT)=IEN
- +36 QUIT
- +37 ;
- +38 ; = = = = = = = = = = = = = = = = =
- +39 ;
- PRSIEN() ;RETURN PAID IEN FROM 450 BASED ON DUZ.
- +1 NEW SSN
- +2 ;
- +3 SET PRSIEN=""
- +4 if 'DUZ
- QUIT PRSIEN
- +5 ;
- +6 SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
- +7 IF SSN'=""
- SET PRSIEN=$ORDER(^PRSPC("SSN",SSN,0))
- if PRSIEN'>0
- SET PRSIEN=""
- +8 QUIT PRSIEN
- +9 ;
- +10 ; = = = = = = = = = = = = = = = = =
- +11 ;
- CLEAR ; Clear an OT warning. This code called when a user running the
- +1 ; OT warnings option selects clear OT warnings protocol.
- +2 ;
- +3 NEW PRSCREC,PRSCLCNT,PRSELECT,PRSNOCL,DIE,DIR,DIRUT,PLURAL
- +4 ;
- +5 ;allow selection of list items in the display region.
- +6 ;
- +7 DO EN^VALM2("","")
- +8 if $ORDER(VALMY(0))'>0
- QUIT
- +9 ;
- +10 SET PRSCLCNT=0
- SET DIE="^PRST(458.6,"
- +11 SET (PRSCREC,PRSELECT,PRSNOCL)=""
- +12 FOR
- SET PRSCREC=$ORDER(VALMY(PRSCREC))
- if PRSCREC=""
- QUIT
- Begin DoDot:1
- +13 ;
- +14 ;Get ien for 458.6 that matches the list item.
- +15 SET PRSCIEN=$GET(^TMP("PRSAOTW",$JOB,PRSCREC))
- +16 ;
- +17 ;Get status of ot warning
- +18 SET PRSCSTAT=$PIECE($GET(^PRST(458.6,PRSCIEN,0)),U,5)
- +19 ;
- +20 ;increment clearable warning count
- +21 ;& build variable of items that will be cleared
- +22 ;& highlight selected items
- +23 IF PRSCSTAT="A"
- Begin DoDot:2
- +24 SET PRSCLCNT=PRSCLCNT+1
- SET PRSELECT=PRSELECT_","_PRSCREC
- +25 ;
- +26 DO CNTRL^VALM10(PRSCREC,2,$LENGTH(PRSCREC),IORVON,IORVOFF)
- +27 DO CNTRL^VALM10(PRSCREC,5,74,IOINHI,IOINORM)
- DO WRITE^VALM10(PRSCREC)
- End DoDot:2
- End DoDot:1
- +28 ;
- +29 ;strip off leading comma from clear list
- +30 SET PRSELECT=$PIECE(PRSELECT,",",2,999)
- +31 ;
- +32 ;return to list if no active warnings selected.
- +33 ;
- +34 IF PRSELECT=""
- SET VALMSG="No ACTIVE warnings selected."
- SET VALMBCK="R"
- QUIT
- +35 ;
- +36 ; If user wants to clear items then clear all selected. Skip any
- +37 ; that r already clear & keep track of any that are locked (PRSNOCL).
- +38 ; Build ListMan message w/ all unclearable records due to locks.
- +39 ;
- +40 SET DIR(0)="YA"
- +41 SET PLURAL=$SELECT($LENGTH(PRSELECT,",")<2:"entry",1:"entries")
- +42 SET DIR("A")="Clear "_PLURAL_" "_PRSELECT_" ?"
- +43 DO ^DIR
- +44 IF Y
- Begin DoDot:1
- +45 SET PRSCREC=0
- +46 FOR
- SET PRSCREC=$ORDER(VALMY(PRSCREC))
- if PRSCREC=""
- QUIT
- Begin DoDot:2
- +47 SET PRSCIEN=$GET(^TMP("PRSAOTW",$JOB,PRSCREC))
- +48 SET PRSCSTAT=$PIECE($GET(^PRST(458.6,PRSCIEN,0)),U,5)
- +49 IF PRSCSTAT="A"
- Begin DoDot:3
- +50 SET PRSCSTAT="C"
- +51 SET DR="4///^S X=PRSCSTAT"
- SET DA=PRSCIEN
- +52 LOCK +^PRST(458.6,PRSCIEN):0
- +53 IF $TEST
- Begin DoDot:4
- +54 DO ^DIE
- LOCK -^PRST(458.6,PRSCIEN)
- End DoDot:4
- +55 IF '$TEST
- SET PRSNOCL=PRSNOCL_" "_PRSCREC
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +56 if PRSNOCL'=""
- SET VALMSG=PRSNOCL_" NOT CLEARED. EDIT BY ANOTHER USER"
- +57 ;
- +58 ;whether list items cleared or not rebuild list and return
- +59 ;
- +60 DO INIT
- +61 SET VALMBCK="R"
- +62 QUIT
- HELP ;Help for the PRSA OVERTIME WARNINGS list template
- +1 DO FULL^VALM1
- +2 WRITE !!,?2,"At the Action prompt you may enter CL or VI.",!
- +3 WRITE !,?4,"Enter CL to select any of the active overtime warnings on the"
- +4 WRITE !,?4,"screen that you wish to clear.",!
- +5 WRITE !,?4,"Enter VI to select one of the displayed warnings to view requests"
- +6 WRITE !,?4,"on file that correlate to the week and pay period of the warning."
- +7 DO PAUSE^VALM1
- +8 DO RE^VALM4
- +9 QUIT