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

PRSPCORE.m

Go to the documentation of this file.
  1. PRSPCORE ;WOIFO/JAH - pt phys report on Core Hour Tours ;01/22/05
  1. ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; Report all tours of duty that currently have a Core Hours
  1. ; designation in the TOUR OF DUTY(#457.1)
  1. ;
  1. ; The Payroll Supervisor will need to remove the
  1. ; designation from the indicated tour.
  1. ;
  1. Q
  1. COREHRS ; main driver for the core hours report
  1. ; Get Station Number
  1. N Y,%,TSTAMP,%ZIS,POP,INCLUDE,PPI,PPE
  1. D NOW^%DTC S Y=% D DD^%DT S TSTAMP=Y
  1. ;
  1. ; look for core designation in the tours
  1. ;
  1. D INTRO
  1. Q:$$ASK^PRSLIB00(1)
  1. S INCLUDE=$$INCLEMP^PRSPCORE()
  1. Q:INCLUDE<0
  1. S PPI=0
  1. I INCLUDE S PPI=$$WHICHPP() Q:PPI<0
  1. I PPI>0 S PPE=$P(^PRST(458,PPI,0),U)
  1. ; if the pay period is not open then don't try to print employee list
  1. I PPI=0 S INCLUDE=0
  1. ;
  1. S %ZIS="MQ"
  1. D ^%ZIS
  1. Q:POP
  1. I $D(IO("Q")) D
  1. . K IO("Q")
  1. . N ZTDESC,ZTRTN,ZTSAVE
  1. . S ZTDESC="PAID TOURS WITH CORE TIME REPORT",ZTRTN="TOURCHK^PRSPCORE"
  1. . S ZTSAVE("TSTAMP")="",ZTSAVE("INCLUDE")="",ZTSAVE("PPI")="",ZTSAVE("PPE")=""
  1. . D ^%ZTLOAD
  1. .;
  1. E D
  1. . D TOURCHK
  1. Q
  1. ;
  1. INTRO ;always show the option description to the user since this is
  1. ; standalone secondary option.
  1. N X,Y,DIC,PRSHLP,PRSER,OPTIEN,LN
  1. W @IOF,!
  1. S X="PRSP PS CORE HRS RPT"
  1. S DIC="^DIC(19,"
  1. S DIC(0)="MZ"
  1. D ^DIC
  1. Q:$G(Y)'>0
  1. S OPTIEN=+$G(Y)
  1. S X=$$GET1^DIQ(19,OPTIEN,3.5,,"PRSHLP","PRSER")
  1. S LN=0
  1. F S LN=$O(PRSHLP(LN)) Q:LN'>0 D
  1. . W !,PRSHLP(LN)
  1. S LN=0
  1. F S LN=$O(PRSER(LN)) Q:LN'>0 D
  1. . W !,PRSER(LN)
  1. Q
  1. HDR(TSTAMP) ;
  1. N I,L1
  1. W @IOF,!
  1. I $G(INCLUDE) W ?2,"Employee search in PP ",PPE," included."
  1. W ?(IOM-$L(TSTAMP)-1),TSTAMP
  1. S L1="PAID - TOURS OF DUTY WITH PHYS/DENT CORE HOURS SEGMENTS REPORT"
  1. W !,?(IOM-$L(L1))/2,L1
  1. W !," TOUR #",?10,"TOUR NAME",?50,"SEGMENT"
  1. W !
  1. F I=1:1:IOM-1 W "-"
  1. Q
  1. ;
  1. RET(TSTAMP) ;
  1. I ($E(IOST,1,2)'="C-")!($D(ZTQUEUED)) D HDR(TSTAMP) Q 0
  1. ;
  1. N OUT
  1. S OUT=$$ASK^PRSLIB00(1)
  1. I 'OUT D HDR(TSTAMP)
  1. Q OUT
  1. ;
  1. TOURCHK ; check tour of duty file for tours with special time Phy/Dent core
  1. ;
  1. ; STIEN-SPECIAL TOUR INDICATOR IEN (457.2)
  1. ; STPTR-POINTER FROM TOUR OF DUTY FILE TO THE SPECIAL TOUR IND FILE
  1. ;
  1. U IO
  1. N I,ZNODE,NODE1,OUT,STPTR,STIEN,STCNT,SEGCNT,HASCORE,NODEX,TOUR
  1. ; Loop through tours
  1. ;
  1. S STIEN=$O(^PRST(457.2,"B","Phy/Den Core Hours",0))
  1. I STIEN'>0 D Q
  1. . D HDR(TSTAMP)
  1. . W !!,"REPORT ABORTED!"
  1. . W !,"No Phy/Den Core Hours entry found in file 457.2"
  1. S (STCNT,TOUR,OUT)=0,NODEX=1
  1. D HDR(TSTAMP)
  1. F S TOUR=$O(^PRST(457.1,TOUR)) Q:TOUR'>0!(OUT) D
  1. . S HASCORE=0
  1. . S ZNODE=$G(^PRST(457.1,TOUR,0))
  1. . S NODE1=$G(^PRST(457.1,TOUR,1))
  1. . ;
  1. . ; Loop through 7 Special Codes looking for code
  1. . ; #3 Phy/Den Core Hours
  1. . ;
  1. . S SEGCNT=0
  1. . F I=3:3:21 D
  1. .. S STPTR=$P(NODE1,U,I)
  1. .. I STPTR=STIEN S SEGCNT=SEGCNT+1 D
  1. ... S HASCORE=1
  1. ... I SEGCNT=1 D
  1. .... S STCNT=STCNT+1
  1. .... W !!,$J(TOUR,7),?10,$P(ZNODE,U)
  1. ... E D
  1. .... W !
  1. ... W ?50,I/3,": ",$P(NODE1,U,I-2)," - ",$P(NODE1,U,I-1)
  1. .;
  1. . I $Y>(IOSL-3) S OUT=$$RET(TSTAMP) Q:OUT
  1. . I HASCORE S OUT=$$TLLIST^PRSPCORE(TOUR,TSTAMP) Q:OUT
  1. . I INCLUDE,HASCORE S OUT=$$EMPLIST(TSTAMP,TOUR,PPI,TOUR) S HASCORE=0 Q:OUT
  1. ;
  1. ;
  1. I STCNT=0 W !!,?5,"No Tours were found with Special Tour Indicator of Phy/Den Core Hrs"
  1. D ^%ZISC
  1. I $D(ZTSK) S ZTREQ="@"
  1. Q
  1. WHICHPP() ;
  1. N PPI,SRT,DFN
  1. S PPI=$P($G(^PRST(458,"AD",DT)),U)
  1. I PPI'>0 S PPI=$O(^PRST(458,99999),-1)
  1. Q:PPI'>0
  1. S DFN=0 D NOL^PRSATE2
  1. S PPI=$S(SRT="L":PPI-1,SRT="N":PPI+1,SRT="C":PPI,1:-1)
  1. Q:PPI<0 PPI
  1. I '$G(^PRST(458,PPI,0)) S PPI=0 W !,"No employee tour data available for the unopened pay period."
  1. Q PPI
  1. INCLEMP() ;ASK USER IF THEY WANT TO INCLUDE EMPLOYEES WITH THE TOUR
  1. N DIR,DIRUT,Y,INCLUDE
  1. S DIR(0)="YA0"
  1. S DIR("B")="N"
  1. S DIR("A")="List employees with Phys/Den Core Hours Tours?"
  1. D ^DIR
  1. S INCLUDE=+Y
  1. I $D(DIRUT) S INCLUDE=-1
  1. Q INCLUDE
  1. EMPLIST(TS,TR,PPI,STIEN) ;LOOP THRU PP TO DISPLAY EMPS W/ PHY/DEN CORE TOURS
  1. ;
  1. N PRSIEN,PRSD,TRNODE,TR1,TR2,CORECNT,FOUND,OUT
  1. S OUT=0
  1. W !
  1. S (CORECNT,PRSIEN,OUT)=0
  1. ; ^PRST(458,236,"E",12717,"D",12,0) = 12^295^0^9^13198^3050114.11 ...
  1. ;
  1. F S PRSIEN=$O(^PRST(458,PPI,"E",PRSIEN)) Q:PRSIEN'>0!(OUT) D
  1. . S (PRSD,FOUND)=0
  1. . F PRSD=1:1:14 D
  1. .. S TRNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
  1. .. S TR1=$P(TRNODE,U,2)
  1. .. S TR2=$P(TRNODE,U,13)
  1. .. I (TR1=STIEN)!(TR2=STIEN) S FOUND=1,CORECNT=CORECNT+1 Q
  1. . S ZNODE=$G(^PRSPC(PRSIEN,0))
  1. . I FOUND W !,?12,$P(ZNODE,U),?45,"T&L: ",$P(ZNODE,U,8),?67,"nnn-nn-",$E($P(ZNODE,U,9),6,9)
  1. . I $Y>(IOSL-3) S OUT=$$RET(TSTAMP) Q:OUT
  1. I CORECNT=0 W !,?12,"No employees with this core hours tour in pp ",PPE
  1. Q OUT
  1. ;
  1. TLLIST(TIE,TSTAMP) ;LOOP THRU TOUR TO DISPLAY ASSOCIATED T&Ls
  1. ; INPUT : Tour Internal Entry number
  1. ; local vars:
  1. ; ATL - Associated T & L unit
  1. ; ATLCT - count the assoc tls
  1. N ATL,ATLCT,OUT
  1. W !,?12,"Associated T&Ls: "
  1. I $$GET1^DIQ(457.1,TIE,4,,,)="YES" D Q 0
  1. . W "This tour is available to all T&L units."
  1. ;
  1. S (OUT,ATLCT,ATL)=0
  1. F S ATL=$O(^PRST(457.1,TIE,"T","B",ATL)) Q:ATL'>0!(OUT) D
  1. . I $X>(IOM-10) D
  1. .. W ", ",!,?29
  1. . E D
  1. .. I ATLCT>0 W ", "
  1. . I $Y>(IOSL-3) S OUT=$$RET(TSTAMP) Q:OUT W !!,?12,"Associated T&Ls: "
  1. . S ATLCT=ATLCT+1
  1. . W $$GET1^DIQ(455.5,ATL,.01,,,)
  1. I ATLCT=0 W "No T&L units are associated with this tour."
  1. Q OUT