PRSNRSM1 ;WOIFO/DAM - Group Work Summary by Skill Mix II REPORT ;060409
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
;
;
GATHER(SKILMIX,GRP,NUROLE,PRSIEN,BEG,END) ;Entry point to gather POC data from 451
;INPUT:
; SKILMIX: ARRAY containing totals for various types of work
; subscripted by nurse role (or skill mix)
; GRP: Nurse default location or T&L Unit
; NUROLE: the role (f451.1) of the nurse defined by PRSIEN
; this role will match one of the subscripts in the
; SKILMIX array
; PRSIEN: Nurse ien 450
; BEG,END: FileMan begin and end dates for report
;
N FMDT,INDEX,CNT,DAYNODE,PPIEN,PRSNDAY,POCD
;
S FMDT=BEG-.1
S (INDEX,CNT)=0
F S FMDT=$O(^PRST(458,"AD",FMDT)) Q:FMDT>END!(FMDT'>0)!STOP D
. S DAYNODE=$G(^PRST(458,"AD",FMDT))
. S PPIEN=+DAYNODE
. S PRSNDAY=$P(DAYNODE,U,2)
. K POCD ;array to hold POC data
. D L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
. Q:$G(POCD(0))=0
. D DATA(.SKILMIX,GRP,NUROLE)
;
Q
;
HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
;
W @IOF
S PG=PG+1
W ?17,"NURSE GROUP WORK SUMMARY BY SKILL MIX REPORT"
W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
W ! ;blank line
W !,"Grouping",?30,"Direct Care",?45,"Nondirect Care",?65,"Leave Hours"
W !,?1,"-Skill Mix",?33,"Hours",?49,"Hours"
W !,"--------------------------------------------------------------------------------"
;
Q
;
DATA(SKILMIX,GRP,NUROLE) ;Extract display data from POCD array
;
N PRSL,ST,SP,MEAL,HOURS,TT,TIEN,LNG,POC,POC1,WIEN,TW,TWD
S STOP=0
;
;
S PRSL=0
F S PRSL=$O(POCD(PRSL)) Q:PRSL'>0!STOP D
. ;Start Time
. S ST=$P(POCD(PRSL),U)
. ;
. ;Stop Time
. S SP=$P(POCD(PRSL),U,2)
. ;
. ;Meal Time
. S MEAL=$P(POCD(PRSL),U,3)
. ;
. ;Get elapsed time
. ;
. S HOURS=$$AMT^PRSPSAPU(ST,SP,MEAL)
. ;
. ;Type of Time code IEN
. S (TIEN,LNG)=""
. S TT=$P(POCD(PRSL),U,4) I TT'="" D
. . ;
. . ;Type of Time code
. . S TIEN=$O(^PRST(457.3,"B",TT,"")) Q:TIEN=""!STOP
. . ;
. . ;Description for Type of Time code
. . S LNG=$P(^PRST(457.3,TIEN,0),U,2) ;eg, Direct Care, AL
. . ;
. S POC1=""
. S POC=$P(POCD(PRSL),U,5) I POC'="" D
. . S POC1=$P($$ISACTIVE^PRSNUT01(DT,POC),U,2) ;Location
. ;
. ;Type of Work Code IEN
. S WIEN=$P(POCD(PRSL),U,6) I WIEN'="" D
. . ;
. . ;Type of Work Code
. . S TW=$P(^PRSN(451.5,WIEN,0),U)
. . ;
. . ;Description for Type of Work code
. . S TWD=$P(^PRSN(451.5,WIEN,0),U,2)
.
.; save skill mix and hours into SKILMIX array
. Q:(LNG="")!(POC1="")
.;
.; If we find leave then update totals, otherwise it's work
.; (direct or nondirect) we update.
. ;S $P(SKILMIX(NUROLE),U,4)=GRP ;Nurse default location
. I "^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^"[(U_TT_U) D
.. S $P(SKILMIX(GRP,NUROLE),U,3)=$P($G(SKILMIX(GRP,NUROLE)),U,3)+HOURS
. E D
.. I $G(TW)="DC" D
... S $P(SKILMIX(GRP,NUROLE),U,1)=$P($G(SKILMIX(GRP,NUROLE)),U,1)+HOURS
.. E D
... S $P(SKILMIX(GRP,NUROLE),U,2)=$P($G(SKILMIX(GRP,NUROLE)),U,2)+HOURS
Q
PRTLP(EXTBEG,EXTEND,STOP) ;Order through the SKILMIX array and pull information for display
N LV,DC,NDC,GP,SKILL
S GP=0
F S GP=$O(SKILMIX(GP)) Q:GP=""!STOP D
. S SKILL=0
. F S SKILL=$O(SKILMIX(GP,SKILL)) Q:SKILL=""!STOP D
.. S LV=$P(SKILMIX(GP,SKILL),U,3)
.. S DC=$P(SKILMIX(GP,SKILL),U)
.. S NDC=$P(SKILMIX(GP,SKILL),U,2)
.. D PPP(EXTBEG,EXTEND,.STOP)
Q
PPP(EXTBEG,EXTEND,STOP) ;
W !
W GP
W !
W ?1,"-"_SKILL
W ?35,DC
W ?51,NDC
W ?70,LV
W !
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR(EXTBEG,EXTEND)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRSM1 3787 printed Oct 16, 2024@18:28:20 Page 2
PRSNRSM1 ;WOIFO/DAM - Group Work Summary by Skill Mix II REPORT ;060409
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 ;
GATHER(SKILMIX,GRP,NUROLE,PRSIEN,BEG,END) ;Entry point to gather POC data from 451
+1 ;INPUT:
+2 ; SKILMIX: ARRAY containing totals for various types of work
+3 ; subscripted by nurse role (or skill mix)
+4 ; GRP: Nurse default location or T&L Unit
+5 ; NUROLE: the role (f451.1) of the nurse defined by PRSIEN
+6 ; this role will match one of the subscripts in the
+7 ; SKILMIX array
+8 ; PRSIEN: Nurse ien 450
+9 ; BEG,END: FileMan begin and end dates for report
+10 ;
+11 NEW FMDT,INDEX,CNT,DAYNODE,PPIEN,PRSNDAY,POCD
+12 ;
+13 SET FMDT=BEG-.1
+14 SET (INDEX,CNT)=0
+15 FOR
SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
if FMDT>END!(FMDT'>0)!STOP
QUIT
Begin DoDot:1
+16 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
+17 SET PPIEN=+DAYNODE
+18 SET PRSNDAY=$PIECE(DAYNODE,U,2)
+19 ;array to hold POC data
KILL POCD
+20 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
+21 if $GET(POCD(0))=0
QUIT
+22 DO DATA(.SKILMIX,GRP,NUROLE)
End DoDot:1
+23 ;
+24 QUIT
+25 ;
HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE ?17,"NURSE GROUP WORK SUMMARY BY SKILL MIX REPORT"
+5 WRITE !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$JUSTIFY(PG,3)
+6 ;blank line
WRITE !
+7 WRITE !,"Grouping",?30,"Direct Care",?45,"Nondirect Care",?65,"Leave Hours"
+8 WRITE !,?1,"-Skill Mix",?33,"Hours",?49,"Hours"
+9 WRITE !,"--------------------------------------------------------------------------------"
+10 ;
+11 QUIT
+12 ;
DATA(SKILMIX,GRP,NUROLE) ;Extract display data from POCD array
+1 ;
+2 NEW PRSL,ST,SP,MEAL,HOURS,TT,TIEN,LNG,POC,POC1,WIEN,TW,TWD
+3 SET STOP=0
+4 ;
+5 ;
+6 SET PRSL=0
+7 FOR
SET PRSL=$ORDER(POCD(PRSL))
if PRSL'>0!STOP
QUIT
Begin DoDot:1
+8 ;Start Time
+9 SET ST=$PIECE(POCD(PRSL),U)
+10 ;
+11 ;Stop Time
+12 SET SP=$PIECE(POCD(PRSL),U,2)
+13 ;
+14 ;Meal Time
+15 SET MEAL=$PIECE(POCD(PRSL),U,3)
+16 ;
+17 ;Get elapsed time
+18 ;
+19 SET HOURS=$$AMT^PRSPSAPU(ST,SP,MEAL)
+20 ;
+21 ;Type of Time code IEN
+22 SET (TIEN,LNG)=""
+23 SET TT=$PIECE(POCD(PRSL),U,4)
IF TT'=""
Begin DoDot:2
+24 ;
+25 ;Type of Time code
+26 SET TIEN=$ORDER(^PRST(457.3,"B",TT,""))
if TIEN=""!STOP
QUIT
+27 ;
+28 ;Description for Type of Time code
+29 ;eg, Direct Care, AL
SET LNG=$PIECE(^PRST(457.3,TIEN,0),U,2)
+30 ;
End DoDot:2
+31 SET POC1=""
+32 SET POC=$PIECE(POCD(PRSL),U,5)
IF POC'=""
Begin DoDot:2
+33 ;Location
SET POC1=$PIECE($$ISACTIVE^PRSNUT01(DT,POC),U,2)
End DoDot:2
+34 ;
+35 ;Type of Work Code IEN
+36 SET WIEN=$PIECE(POCD(PRSL),U,6)
IF WIEN'=""
Begin DoDot:2
+37 ;
+38 ;Type of Work Code
+39 SET TW=$PIECE(^PRSN(451.5,WIEN,0),U)
+40 ;
+41 ;Description for Type of Work code
+42 SET TWD=$PIECE(^PRSN(451.5,WIEN,0),U,2)
End DoDot:2
+43 +44 ; save skill mix and hours into SKILMIX array
+45 if (LNG="")!(POC1="")
QUIT
+46 ;
+47 ; If we find leave then update totals, otherwise it's work
+48 ; (direct or nondirect) we update.
+49 ;S $P(SKILMIX(NUROLE),U,4)=GRP ;Nurse default location
+50 IF "^HX^AL^AA^DL^ML^RL^SL^CB^AD^WP^"[(U_TT_U)
Begin DoDot:2
+51 SET $PIECE(SKILMIX(GRP,NUROLE),U,3)=$PIECE($GET(SKILMIX(GRP,NUROLE)),U,3)+HOURS
End DoDot:2
+52 IF '$TEST
Begin DoDot:2
+53 IF $GET(TW)="DC"
Begin DoDot:3
+54 SET $PIECE(SKILMIX(GRP,NUROLE),U,1)=$PIECE($GET(SKILMIX(GRP,NUROLE)),U,1)+HOURS
End DoDot:3
+55 IF '$TEST
Begin DoDot:3
+56 SET $PIECE(SKILMIX(GRP,NUROLE),U,2)=$PIECE($GET(SKILMIX(GRP,NUROLE)),U,2)+HOURS
End DoDot:3
End DoDot:2
End DoDot:1
+57 QUIT
PRTLP(EXTBEG,EXTEND,STOP) ;Order through the SKILMIX array and pull information for display
+1 NEW LV,DC,NDC,GP,SKILL
+2 SET GP=0
+3 FOR
SET GP=$ORDER(SKILMIX(GP))
if GP=""!STOP
QUIT
Begin DoDot:1
+4 SET SKILL=0
+5 FOR
SET SKILL=$ORDER(SKILMIX(GP,SKILL))
if SKILL=""!STOP
QUIT
Begin DoDot:2
+6 SET LV=$PIECE(SKILMIX(GP,SKILL),U,3)
+7 SET DC=$PIECE(SKILMIX(GP,SKILL),U)
+8 SET NDC=$PIECE(SKILMIX(GP,SKILL),U,2)
+9 DO PPP(EXTBEG,EXTEND,.STOP)
End DoDot:2
End DoDot:1
+10 QUIT
PPP(EXTBEG,EXTEND,STOP) ;
+1 WRITE !
+2 WRITE GP
+3 WRITE !
+4 WRITE ?1,"-"_SKILL
+5 WRITE ?35,DC
+6 WRITE ?51,NDC
+7 WRITE ?70,LV
+8 WRITE !
+9 ;
+10 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR(EXTBEG,EXTEND)
+11 QUIT
