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

PRSNRSM1.m

Go to the documentation of this file.
  1. PRSNRSM1 ;WOIFO/DAM - Group Work Summary by Skill Mix II 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. ;
  1. GATHER(SKILMIX,GRP,NUROLE,PRSIEN,BEG,END) ;Entry point to gather POC data from 451
  1. ;INPUT:
  1. ; SKILMIX: ARRAY containing totals for various types of work
  1. ; subscripted by nurse role (or skill mix)
  1. ; GRP: Nurse default location or T&L Unit
  1. ; NUROLE: the role (f451.1) of the nurse defined by PRSIEN
  1. ; this role will match one of the subscripts in the
  1. ; SKILMIX array
  1. ; PRSIEN: Nurse ien 450
  1. ; BEG,END: FileMan begin and end dates for report
  1. ;
  1. N FMDT,INDEX,CNT,DAYNODE,PPIEN,PRSNDAY,POCD
  1. ;
  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(.SKILMIX,GRP,NUROLE)
  1. ;
  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 ?17,"NURSE GROUP WORK SUMMARY BY SKILL MIX REPORT"
  1. W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
  1. W ! ;blank line
  1. W !,"Grouping",?30,"Direct Care",?45,"Nondirect Care",?65,"Leave Hours"
  1. W !,?1,"-Skill Mix",?33,"Hours",?49,"Hours"
  1. W !,"--------------------------------------------------------------------------------"
  1. ;
  1. Q
  1. ;
  1. DATA(SKILMIX,GRP,NUROLE) ;Extract display data from POCD array
  1. ;
  1. N PRSL,ST,SP,MEAL,HOURS,TT,TIEN,LNG,POC,POC1,WIEN,TW,TWD
  1. S STOP=0
  1. ;
  1. ;
  1. S PRSL=0
  1. F S PRSL=$O(POCD(PRSL)) Q:PRSL'>0!STOP D
  1. . ;Start Time
  1. . S ST=$P(POCD(PRSL),U)
  1. . ;
  1. . ;Stop Time
  1. . S SP=$P(POCD(PRSL),U,2)
  1. . ;
  1. . ;Meal Time
  1. . S MEAL=$P(POCD(PRSL),U,3)
  1. . ;
  1. . ;Get elapsed time
  1. . ;
  1. . S HOURS=$$AMT^PRSPSAPU(ST,SP,MEAL)
  1. . ;
  1. . ;Type of Time code IEN
  1. . S (TIEN,LNG)=""
  1. . S TT=$P(POCD(PRSL),U,4) I TT'="" D
  1. . . ;
  1. . . ;Type of Time code
  1. . . S TIEN=$O(^PRST(457.3,"B",TT,"")) Q:TIEN=""!STOP
  1. . . ;
  1. . . ;Description for Type of Time code
  1. . . S LNG=$P(^PRST(457.3,TIEN,0),U,2) ;eg, Direct Care, AL
  1. . . ;
  1. . S POC1=""
  1. . S POC=$P(POCD(PRSL),U,5) I POC'="" D
  1. . . S POC1=$P($$ISACTIVE^PRSNUT01(DT,POC),U,2) ;Location
  1. . ;
  1. . ;Type of Work Code IEN
  1. . S WIEN=$P(POCD(PRSL),U,6) I WIEN'="" D
  1. . . ;
  1. . . ;Type of Work Code
  1. . . S TW=$P(^PRSN(451.5,WIEN,0),U)
  1. . . ;
  1. . . ;Description for Type of Work code
  1. . . S TWD=$P(^PRSN(451.5,WIEN,0),U,2)
  1. .
  1. .; save skill mix and hours into SKILMIX array
  1. . Q:(LNG="")!(POC1="")
  1. .;
  1. .; If we find leave then update totals, otherwise it's work
  1. .; (direct or nondirect) we update.
  1. . ;S $P(SKILMIX(NUROLE),U,4)=GRP ;Nurse default location
  1. . I "^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^"[(U_TT_U) D
  1. .. S $P(SKILMIX(GRP,NUROLE),U,3)=$P($G(SKILMIX(GRP,NUROLE)),U,3)+HOURS
  1. . E D
  1. .. I $G(TW)="DC" D
  1. ... S $P(SKILMIX(GRP,NUROLE),U,1)=$P($G(SKILMIX(GRP,NUROLE)),U,1)+HOURS
  1. .. E D
  1. ... S $P(SKILMIX(GRP,NUROLE),U,2)=$P($G(SKILMIX(GRP,NUROLE)),U,2)+HOURS
  1. Q
  1. PRTLP(EXTBEG,EXTEND,STOP) ;Order through the SKILMIX array and pull information for display
  1. N LV,DC,NDC,GP,SKILL
  1. S GP=0
  1. F S GP=$O(SKILMIX(GP)) Q:GP=""!STOP D
  1. . S SKILL=0
  1. . F S SKILL=$O(SKILMIX(GP,SKILL)) Q:SKILL=""!STOP D
  1. .. S LV=$P(SKILMIX(GP,SKILL),U,3)
  1. .. S DC=$P(SKILMIX(GP,SKILL),U)
  1. .. S NDC=$P(SKILMIX(GP,SKILL),U,2)
  1. .. D PPP(EXTBEG,EXTEND,.STOP)
  1. Q
  1. PPP(EXTBEG,EXTEND,STOP) ;
  1. W !
  1. W GP
  1. W !
  1. W ?1,"-"_SKILL
  1. W ?35,DC
  1. W ?51,NDC
  1. W ?70,LV
  1. W !
  1. ;
  1. I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR(EXTBEG,EXTEND)
  1. Q