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

PRSNRAS1.m

Go to the documentation of this file. 
  1. PRSNRAS1 ;WOIFO/DAM - POC GROUP ACTIVITY SUMMARY REPORT ;060409
  1.  ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  ;
  1.  Q
  1.  ; 
  1. DSPLY(PRSIEN,BEG,END,EXTBEG,EXTEND,STOP) ; gather POC data from 451
  1.  ;INPUT:
  1.  ;   PRSIEN: Nurse ien 450
  1.  ;   BEG,END: FileMan begin and end dates for report
  1.  ;
  1.  N INDEX,CNT,DAYNODE,FMDT,POCD,WKTOT
  1.  N PRSNAME,PRSNTL,SKILMIX,MIX1,MIX2
  1.  N PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
  1.  N PPIEN,PRSL,PRSNDAY,STARTDT,STDE,PRSNSSN
  1.  D INFO
  1.  S FMDT=BEG-.1
  1.  S (INDEX,CNT)=0
  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.  . K POCD   ;array to hold POC data
  1.  . D L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
  1.  . Q:$G(POCD(0))=0
  1.  . D DATA
  1.  ;
  1.  D PRTLOOP(EXTBEG,EXTEND)
  1.  Q
  1.  ;
  1. INFO ;Find nurse information to display in report
  1.  ;
  1.  N PRSNARY
  1.  ;
  1.  S PRSL=1
  1.  S PRSNARY=$G(^PRSPC(PRSIEN,0))
  1.  S PRSNAME=$P(PRSNARY,U)              ;Nurse Name
  1.  S PRSNSSN=$P(PRSNARY,U,9)           ;Nurse SSN
  1.  S PRSNTL=$P(PRSNARY,U,8)             ;Nurse T&L
  1.  S SKILMIX=$P($$ISNURSE^PRSNUT01(PRSIEN),U,2) ;  Nurse skillmix
  1.  I SKILMIX["ADMINISTRATIVE" S SKILMIX="ADMIN RN"
  1.  Q
  1.  ;
  1. HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
  1.  ;
  1.  W @IOF
  1.  S PG=PG+1
  1.  W ?25,"GROUP ACTIVITY SUMMARY REPORT"
  1.  W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
  1.  W !         ;blank line
  1.  W !,"Nurse Name",?21,"Type of",?32,"Type of",?48,"Location",?68,"# of",?75,"T&L"
  1.  W !,"Skill Mix",?22,"Time",?33,"Work",?68,"Hours",?75,"Unit"
  1.  W !,"--------------------------------------------------------------------------------",!
  1.  ;
  1.  Q
  1.  ;
  1. DATA ;Extract display data from POCD array
  1.  ;
  1.  N PRSNST,PRSNSP,PRSNPOC,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
  1.  N PRSNTW,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL,PRSEQ
  1.  S (PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY)=""
  1.  S PRSNTIEN=0
  1.  ;
  1.  ;
  1.  S PRSEQ=0
  1.  F  S PRSEQ=$O(POCD(PRSEQ)) Q:PRSEQ'>0!STOP  D
  1.  . ;Start Time
  1.  . S PRSNST=$P(POCD(PRSEQ),U)
  1.  . ;
  1.  . ;Stop Time 
  1.  . S PRSNSP=$P(POCD(PRSEQ),U,2)
  1.  . ;
  1.  . ;Meal Time
  1.  . S MEAL=$P(POCD(PRSEQ),U,3)
  1.  . ;
  1.  . ;Get hours worked in a given location
  1.  . S HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
  1.  . ;
  1.  . ;Type of Time code IEN
  1.  . S PRSNTT=$P(POCD(PRSEQ),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=""
  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(PRSEQ),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(PRSEQ),U,6),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.  .; save hours into work array
  1.  . I '$D(WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1)) D
  1.  .. S CNT=CNT+1
  1.  .. S (INDEX,WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1,0))=CNT
  1.  . E  D
  1.  .. S INDEX=$G(WKTOT(PRSNLNG,PRSNTWD,PRSNPOC1,0))
  1.  . S WKTOT(INDEX,PRSNLNG,PRSNTWD,PRSNPOC1)=$G(WKTOT(INDEX,PRSNLNG,PRSNTWD,PRSNPOC1))+HOURS
  1.  ;
  1.  Q
  1.  ;
  1. PRTLOOP(EXTBEG,EXTEND) ;  Loop through Totals array and print each one
  1.  ;
  1.  N PRSEQ,TT,TWD,POC,CNT
  1.  S PRSEQ=0,CNT=0
  1.  F  S PRSEQ=$O(WKTOT(PRSEQ)) Q:PRSEQ'>0!STOP  D
  1.  . S TT=""
  1.  . F  S TT=$O(WKTOT(PRSEQ,TT)) Q:TT=""!STOP  D
  1.  .. S TWD=""
  1.  .. F  S TWD=$O(WKTOT(PRSEQ,TT,TWD)) Q:TWD=""!STOP  D
  1.  ... S POC=""
  1.  ... F  S POC=$O(WKTOT(PRSEQ,TT,TWD,POC)) Q:POC=""!STOP  D
  1.  .... S HOURS=$G(WKTOT(PRSEQ,TT,TWD,POC)),CNT=CNT+1
  1.  .... D PPP(EXTBEG,EXTEND)
  1.  ; need a blank line between nurses when there was only one record printed
  1.  I CNT=1 W !
  1.  Q
  1.  ;
  1. PPP(EXTBEG,EXTEND) ;
  1.  I PRSL W !,$E(PRSNAME,1,19)
  1.  W ?21,TT,?32,$E(TWD,1,14),?48,$E(POC,1,16),?66,$J(HOURS,7,2),?75,PRSNTL
  1.  W !
  1.  I PRSL W "  ",$E(SKILMIX,1,17)
  1.  ;
  1.  S PRSL=0
  1.  I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR(EXTBEG,EXTEND)
  1.  Q