- 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 Feb 18, 2025@23:54:07 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