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

PRSNROLD.m

Go to the documentation of this file. 
  1. PRSNROLD ;WOIFO/JEO - OVERTIMIVIE DETAIL REPORT ;080811
  1.  ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  Q
  1.  ;
  1. DAP ; Entry point for Data Approval Personnel
  1.  N GROUP
  1.  D ACCESS^PRSNUT02(.GROUP,"A",DT,1)
  1.  ; quit if any error during group selection
  1.  I $P($G(GROUP(0)),U,2)="E" D  Q
  1.  .W !,$P(GROUP(0),U,3)
  1.  D MAIN
  1.  Q
  1.  ;
  1. COORD ;Entry point for VANOD Coordinator
  1.  ; Coordinator has no access limits so let them pick any group
  1.  N GROUP
  1.  D PIKGROUP^PRSNUT04(.GROUP,"",1)
  1.  I $P($G(GROUP(0)),U,2)="E" D  Q
  1.  .W !,$P(GROUP(0),U,3)
  1.  D MAIN
  1.  Q
  1. MAIN ;
  1.  N RANGE,BEG,END,LASTDT,MTIME,STIME,ETIME
  1.  N %ZIS,POP,IOP
  1.  K POCD
  1.  D RANGE
  1.  Q:+RANGE'>0
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D
  1.  . K IO("Q")
  1.  . N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
  1.  . S ZTDESC="LOCATION OVERTIME ACTIVITY DETAIL REPORT"
  1.  . S ZTRTN="FILE^PRSNROLD"
  1.  . S ZTSAVE("GROUP(")=""
  1.  . S ZTSAVE("BEG")=""
  1.  . S ZTSAVE("END")=""
  1.  . D ^%ZTLOAD
  1.  . I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
  1.  E  D FILE
  1.  Q
  1.  ;
  1. RANGE ;
  1.  ; User is prompted for a date or date range
  1.  S RANGE=$$POCRANGE^PRSNUT01()
  1.  S BEG=$P($G(RANGE),U)
  1.  S END=$P($G(RANGE),U,2)
  1.  Q
  1.  ;
  1. FILE ;
  1.  ;
  1.  N PRSNL,DAYNODE,EXTBEG,EXTEND,FMDT,PPIEN,PRSNAME,PRSNSSN,PRSNTL
  1.  N PRSNPP,PRSNDAY,PRSNDY,PRSDT,TODAY,DIVI,NURSE
  1.  N PRSIEN,PRSNGLB,PRSNG,GHD,PICK,SORT,STOP,I,PRSNGA,PRSNGB,TAB,PG
  1.  U IO
  1.  S SORT=$P(GROUP(0),U,2),PG=0
  1.  S (PICK,STOP)=0
  1.  S TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1.  D INITIAL^PRSNRUT0
  1.  F  S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP  D
  1.  .S DIVI=$$EXTERNAL^DILFD(456,.01,"",$P(GROUP(PICK),U,3))
  1.  .S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
  1.  .S PRSNGLB=$S($P(PRSNG,U,2)="N":$NA(^NURSF(211.8,"D",$P(PRSNG,U,7))),1:$NA(^PRSPC("ATL"_$P(PRSNG,U,3))))
  1.  .; display and underline group sub header
  1.  .;
  1.  .S GHD=$S($P(PRSNG,U,2)="N":"LOCATION",1:"T&L UNIT")_":  "_$P(PRSNG,U,3)
  1.  .;S TAB=IOM-$L(GHD)/2-5
  1.  .S PRSNGA=""
  1.  .F  S PRSNGA=$O(@PRSNGLB@(PRSNGA)) QUIT:PRSNGA=""!STOP  D
  1.  ..S PRSNGB=0
  1.  ..F  S PRSNGB=$O(@PRSNGLB@(PRSNGA,PRSNGB)) QUIT:'PRSNGB!STOP  D
  1.  ...I $P(PRSNG,U,2)="N",+$P(PRSNG,U,4)'=+$$PRIMLOC^PRSNUT03(PRSNGB) Q
  1.  ...S PRSIEN=$S($P(PRSNG,U,2)="N":+$G(^VA(200,PRSNGB,450)),1:PRSNGB)
  1.  ...S PRSNL=$$DEFAULTL^PRSNRUT0()
  1.  ...I PRSNL="" S PRSNL="**NONE**"
  1.  ...S NURSE=$$ISNURSE^PRSNUT01(PRSIEN)
  1.  ...I +NURSE D INFO(PRSIEN,DIVI,PICK)
  1.  ;
  1.  D ^%ZISC
  1.  Q
  1. INFO(PRSIEN,DIVI,PICK) ;Find nurse information to display in report
  1.  N FMDT,PPIEN,PRSNDAY,POCD,DAYNODE
  1.  N PRSNARY,PRSNAME,PRSNSSN,PRSNTL,SKILMIX
  1.  S PRSNARY=$G(^PRSPC(PRSIEN,0))
  1.  ; Nurse Name
  1.  S PRSNAME=$P(PRSNARY,U)
  1.  ; Nurse SSN
  1.  S PRSNSSN=$P(PRSNARY,U,9)
  1.  ; Nurse T&L
  1.  S PRSNTL=$P(PRSNARY,U,8)
  1.  ; Nurse skillmix
  1.  S SKILMIX=$P($$ISNURSE^PRSNUT01(PRSIEN),U,2)
  1.  I SKILMIX["ADMINISTRATIVE" S SKILMIX="ADMIN RN"
  1.  Q:$G(DIVI)=""!($G(PICK)="")
  1.  S STOP=0
  1.  I PG>0 S STOP=$$ASK^PRSLIB00()
  1.  Q:STOP
  1.  D HDR
  1.  S FMDT=BEG-.1
  1.  F  S FMDT=$O(^PRST(458,"AD",FMDT)) Q:FMDT>END!(FMDT'>0)!STOP  D
  1.  . S DAYNODE=$G(^PRST(458,"AD",FMDT))
  1.  . S PPIEN=+DAYNODE
  1.  . S PRSNDAY=$P(DAYNODE,U,2)
  1.  . Q:'PRSNDAY
  1.  . K POCD   ;array to hold POC data
  1.  . D L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
  1.  . D GETDAY(PRSNDAY,.PRSNDY,.PRSDT),DATA
  1.  Q
  1.  ;     
  1. HDR ;;Display header for report of Individual Nurse Activity
  1.  W @IOF
  1.  S PG=PG+1
  1.  W ?19,"NURSE OVERTIME DETAIL REPORT"
  1.  W !,PRSNAME,?32,$E(PRSNL,1,14),?48,"T&L"_" "_PRSNTL,?48,?68,$E(PRSNSSN,6,9)
  1.  W !,"--------------------------------------------------------------------------------"
  1.  W !,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
  1.  W !                                                         ;blank line
  1.  W !,"Date",?11,"Tour Time",?27,"Location",?46,"# Of",?57,"OT Mandatory"
  1.  W !,?11,"-Exceptions",?27,"-Work Type",?45,"Hours",?57,"-OT Reason"
  1.  W !,"--------------------------------------------------------------------------------"
  1.  Q
  1.  ;
  1. DEFAULTL() ;Find external value-nurse's default location
  1.  ;
  1.  Q $P($$PRIMLOC^PRSNUT03($G(^PRSPC(PRSIEN,200))),U,3)
  1.  ;
  1. GETDAY(PRSNDAY,PRSNDY,PRSDT) ;Find external value of Day Number
  1.  ;
  1.  N PRSDY
  1.  S PRSDY=$P(^PRST(458,PPIEN,2),U,PRSNDAY)
  1.  S PRSNDY=$P(PRSDY," "),PRSDT=$P(PRSDY," ",2,3)
  1.  Q
  1.  ;
  1. DATA ;Extract display data from POCD array
  1.  ;
  1.  N PRSNST,PRSNSP,PRSNPOC,PRSNPOC1,PRSNTT,PRSNWIEN,PRSNLNG,PRSNTW
  1.  N PRSNM,PRSNRE,PRSNREC,PRSNTWD,PRSNRIEN,PRSNTIEN,PRSL
  1.  N STIME,ETIME,OTTIME,PRTDY
  1.  ;
  1.  S PRSL=0,PRTDY=0
  1.  F  S PRSL=$O(POCD(PRSL)) Q:PRSL'>0!STOP  D
  1.  . ;Start and stop time
  1.  . S PRSNST=$P(POCD(PRSL),U),PRSNSP=$P(POCD(PRSL),U,2)
  1.  . ;
  1.  . ;Type of Time code IEN
  1.  . S PRSNTT=$P(POCD(PRSL),U,4),PRSNLNG=" "
  1.  . I PRSNTT'="" D
  1.  . . ;
  1.  . . ;Type of Time code
  1.  . . S PRSNTIEN=$O(^PRST(457.3,"B",PRSNTT,0))
  1.  . . Q:PRSNTIEN'>0
  1.  . . ;
  1.  . . ;Description for Type of Time code
  1.  . . S PRSNLNG=$P(^PRST(457.3,PRSNTIEN,0),U,2)
  1.  . . ;
  1.  . S PRSNPOC=$P(POCD(PRSL),U,5),PRSNPOC1=" "
  1.  . I PRSNPOC'="" D
  1.  . . ;POC
  1.  . . S PRSNPOC1=$P($$ISACTIVE^PRSNUT01(DT,PRSNPOC),U,2)
  1.  . ;
  1.  . ;Type of Work Code IEN
  1.  . S PRSNWIEN=$P(POCD(PRSL),U,6),PRSNTW=" ",PRSNTWD=" "
  1.  . I PRSNWIEN'="" D
  1.  . . ;
  1.  . . ;Type of Work Code
  1.  . . S PRSNTW=$P(^PRSN(451.5,PRSNWIEN,0),U)
  1.  . . ;
  1.  . . ;Description for Type of Work code
  1.  . . S PRSNTWD=$P(^PRSN(451.5,PRSNWIEN,0),U,2)
  1.  . ;
  1.  . ;OT Mandatory/Voluntary
  1.  . S PRSNM=$P(POCD(PRSL),U,7)
  1.  . ;no need to continue if this isn't an overtime record
  1.  . Q:$G(PRSNM)=""
  1.  . I PRSNM="V" S PRSNM="V Voluntary"
  1.  . I PRSNM="M" S PRSNM="M Mandatory"
  1.  . ;
  1.  . S PRSNRIEN=$P(POCD(PRSL),U,8),PRSNREC=" ",PRSNRE=" "
  1.  . I PRSNRIEN'="" D
  1.  . . ;Reason for OT code
  1.  . . S PRSNREC=$P(^PRSN(451.6,PRSNRIEN,0),U)
  1.  . . ;
  1.  . . ;Description for OT code
  1.  . . S PRSNRE=$P(^PRSN(451.6,PRSNRIEN,0),U,2)
  1.  . ;
  1.  . ; OT time
  1.  . S STIME=$P(POCD(PRSL),U,9)
  1.  . S ETIME=$P(POCD(PRSL),U,10)
  1.  . S MTIME=$P(POCD(PRSL),U,3)
  1.  . S OTTIME=$$ELAPSE^PRSPESR2(MTIME,STIME,ETIME)
  1.  . D PRNT
  1.  Q
  1. PRNT ;Print report
  1.  ;
  1.  W !
  1.  I 'PRTDY W PRSNDY
  1.  W ?11,$G(PRSNST)_"-"_$G(PRSNSP),?27,$G(PRSNPOC1),?57,$G(PRSNM)
  1.  W !
  1.  I 'PRTDY W PRSDT
  1.  W ?11,"-"_$G(PRSNTT)_" "_$G(PRSNLNG),?27,"-"_$G(PRSNTW)_" "_$G(PRSNTWD),?46,OTTIME,?57,"-"_$G(PRSNREC)_" "_$G(PRSNRE)
  1.  W !      ;blank line
  1.  S PRTDY=1
  1.  ;
  1.  I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
  1.  Q
  1.  ;