- PRSNRND1 ;WOIFO/DAM - Non Direct Care 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 INDEX,CNT,DAYNODE,FMDT,PPIEN,PRSNDAY
- 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
- ;
- ;
- DATA(SKILMIX,GRP,NUROLE) ;Extract data from POCD array
- ;
- N PRSL,ST,SP,MEAL,HOURS,TT,TIEN,LNG,POC,POC1,WIEN,TW,TWD
- ;
- S PRSL=0
- F S PRSL=$O(POCD(PRSL)) Q:PRSL'>0 D
- . ;
- . ;Start and stop time and mealtime
- . S ST=$P(POCD(PRSL),U),SP=$P(POCD(PRSL),U,2),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,TIEN))
- . . Q:TIEN=""
- . . ;
- . . ;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 (TW,TWD)=" "
- . 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, hours and type of work into SKILMIX array
- . ;
- . I $G(TW)'="DC" D
- .. S $P(SKILMIX(GRP,TWD,NUROLE),U,1)=$P($G(SKILMIX(GRP,TWD,NUROLE)),U,1)+HOURS
- Q
- HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
- ;
- W @IOF
- S PG=PG+1
- W ?17,"NURSE NON DIRECT SUMMARY BY SKILL MIX REPORT"
- W !,?15,EXTBEG_" - "_EXTEND,?45,"Run Date: ",TODAY,?70,"Page: ",$J(PG,3)
- W ! ;blank line
- W !,"Location",?22,"Non Direct",?53,"# of",?60,"# of",?67,"# of",?74,"Total"
- W !,?22,"Care",?53,"Hours",?60,"Hours",?67,"Hours",?74,"Hours"
- W !,?22,"Category",?53,"RN",?60,"LPN",?67,"UAP"
- W !,"--------------------------------------------------------------------------------"
- ;
- Q
- PRTLP(EXTBEG,EXTEND) ;Order through SKILMIX array, total data & display
- N RNDC,LNDC,UNDC,GP,TNDC,SKILL,NDCARE
- S GP=0
- F S GP=$O(SKILMIX(GP)) Q:GP=""!STOP D
- . S NDCARE=""
- . F S NDCARE=$O(SKILMIX(GP,NDCARE)) Q:NDCARE=""!STOP D
- .. S (RNDC,LNDC,UNDC,TNDC)=0
- .. S SKILL=""
- .. F S SKILL=$O(SKILMIX(GP,NDCARE,SKILL)) Q:SKILL=""!STOP D
- ... I SKILL["RN" S RNDC=$P(SKILMIX(GP,NDCARE,SKILL),U)+$G(RNDC)
- ... I SKILL["LPN" S LNDC=$P(SKILMIX(GP,NDCARE,SKILL),U)+$G(LNDC)
- ... I SKILL'["RN",SKILL'["LPN" S UNDC=$P(SKILMIX(GP,NDCARE,SKILL),U)+$G(UNDC)
- .. S TNDC=$G(RNDC)+$G(LNDC)+$G(UNDC) ;total hours
- .. D PPP(.STOP,EXTBEG,EXTEND)
- Q
- PPP(STOP,EXTBEG,EXTEND) ;
- W !
- W GP,?22,NDCARE,?53,RNDC,?60,LNDC,?67,UNDC,?74,TNDC
- 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[HPRSNRND1 3675 printed Feb 18, 2025@23:54:03 Page 2
- PRSNRND1 ;WOIFO/DAM - Non Direct Care 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 ;
- +5 ;
- 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 INDEX,CNT,DAYNODE,FMDT,PPIEN,PRSNDAY
- +12 SET FMDT=BEG-.1
- +13 SET (INDEX,CNT)=0
- +14 FOR
- SET FMDT=$ORDER(^PRST(458,"AD",FMDT))
- if FMDT>END!(FMDT'>0)!STOP
- QUIT
- Begin DoDot:1
- +15 SET DAYNODE=$GET(^PRST(458,"AD",FMDT))
- +16 SET PPIEN=+DAYNODE
- +17 SET PRSNDAY=$PIECE(DAYNODE,U,2)
- +18 ;array to hold POC data
- KILL POCD
- +19 DO L1^PRSNRUT1(.POCD,PPIEN,PRSIEN,PRSNDAY)
- +20 if $GET(POCD(0))=0
- QUIT
- +21 DO DATA(.SKILMIX,GRP,NUROLE)
- End DoDot:1
- +22 ;
- +23 QUIT
- +24 ;
- +25 ;
- DATA(SKILMIX,GRP,NUROLE) ;Extract data from POCD array
- +1 ;
- +2 NEW PRSL,ST,SP,MEAL,HOURS,TT,TIEN,LNG,POC,POC1,WIEN,TW,TWD
- +3 ;
- +4 SET PRSL=0
- +5 FOR
- SET PRSL=$ORDER(POCD(PRSL))
- if PRSL'>0
- QUIT
- Begin DoDot:1
- +6 ;
- +7 ;Start and stop time and mealtime
- +8 SET ST=$PIECE(POCD(PRSL),U)
- SET SP=$PIECE(POCD(PRSL),U,2)
- SET MEAL=$PIECE(POCD(PRSL),U,3)
- +9 ;
- +10 ;Get elapsed time
- +11 SET HOURS=$$AMT^PRSPSAPU(ST,SP,MEAL)
- +12 ;
- +13 ;Type of Time code IEN
- +14 SET (TIEN,LNG)=" "
- +15 SET TT=$PIECE(POCD(PRSL),U,4)
- +16 IF TT'=""
- Begin DoDot:2
- +17 ;
- +18 ;Type of Time code
- +19 SET TIEN=$ORDER(^PRST(457.3,"B",TT,TIEN))
- +20 if TIEN=""
- QUIT
- +21 ;
- +22 ;Description for Type of Time code
- +23 ;eg, Direct Care, AL
- SET LNG=$PIECE(^PRST(457.3,TIEN,0),U,2)
- End DoDot:2
- +24 ;
- +25 SET POC1=" "
- +26 SET POC=$PIECE(POCD(PRSL),U,5)
- +27 IF POC'=""
- Begin DoDot:2
- +28 ;Location
- SET POC1=$PIECE($$ISACTIVE^PRSNUT01(DT,POC),U,2)
- End DoDot:2
- +29 ;
- +30 ;Type of Work Code IEN
- +31 SET (TW,TWD)=" "
- +32 SET WIEN=$PIECE(POCD(PRSL),U,6)
- +33 IF WIEN'=""
- Begin DoDot:2
- +34 ;
- +35 ;Type of Work Code
- +36 SET TW=$PIECE(^PRSN(451.5,WIEN,0),U)
- +37 ;
- +38 ;Description for Type of Work code
- +39 SET TWD=$PIECE(^PRSN(451.5,WIEN,0),U,2)
- End DoDot:2
- +40 ;
- +41 ;save skill mix, hours and type of work into SKILMIX array
- +42 ;
- +43 IF $GET(TW)'="DC"
- Begin DoDot:2
- +44 SET $PIECE(SKILMIX(GRP,TWD,NUROLE),U,1)=$PIECE($GET(SKILMIX(GRP,TWD,NUROLE)),U,1)+HOURS
- End DoDot:2
- End DoDot:1
- +45 QUIT
- HDR(EXTBEG,EXTEND) ;Display header for report of Individual Nurse Activity
- +1 ;
- +2 WRITE @IOF
- +3 SET PG=PG+1
- +4 WRITE ?17,"NURSE NON DIRECT 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 !,"Location",?22,"Non Direct",?53,"# of",?60,"# of",?67,"# of",?74,"Total"
- +8 WRITE !,?22,"Care",?53,"Hours",?60,"Hours",?67,"Hours",?74,"Hours"
- +9 WRITE !,?22,"Category",?53,"RN",?60,"LPN",?67,"UAP"
- +10 WRITE !,"--------------------------------------------------------------------------------"
- +11 ;
- +12 QUIT
- PRTLP(EXTBEG,EXTEND) ;Order through SKILMIX array, total data & display
- +1 NEW RNDC,LNDC,UNDC,GP,TNDC,SKILL,NDCARE
- +2 SET GP=0
- +3 FOR
- SET GP=$ORDER(SKILMIX(GP))
- if GP=""!STOP
- QUIT
- Begin DoDot:1
- +4 SET NDCARE=""
- +5 FOR
- SET NDCARE=$ORDER(SKILMIX(GP,NDCARE))
- if NDCARE=""!STOP
- QUIT
- Begin DoDot:2
- +6 SET (RNDC,LNDC,UNDC,TNDC)=0
- +7 SET SKILL=""
- +8 FOR
- SET SKILL=$ORDER(SKILMIX(GP,NDCARE,SKILL))
- if SKILL=""!STOP
- QUIT
- Begin DoDot:3
- +9 IF SKILL["RN"
- SET RNDC=$PIECE(SKILMIX(GP,NDCARE,SKILL),U)+$GET(RNDC)
- +10 IF SKILL["LPN"
- SET LNDC=$PIECE(SKILMIX(GP,NDCARE,SKILL),U)+$GET(LNDC)
- +11 IF SKILL'["RN"
- IF SKILL'["LPN"
- SET UNDC=$PIECE(SKILMIX(GP,NDCARE,SKILL),U)+$GET(UNDC)
- End DoDot:3
- +12 ;total hours
- SET TNDC=$GET(RNDC)+$GET(LNDC)+$GET(UNDC)
- +13 DO PPP(.STOP,EXTBEG,EXTEND)
- End DoDot:2
- End DoDot:1
- +14 QUIT
- PPP(STOP,EXTBEG,EXTEND) ;
- +1 WRITE !
- +2 WRITE GP,?22,NDCARE,?53,RNDC,?60,LNDC,?67,UNDC,?74,TNDC
- +3 WRITE !
- +4 IF (IOSL-5)<$Y
- SET STOP=$$ASK^PRSLIB00()
- IF 'STOP
- DO HDR(EXTBEG,EXTEND)
- +5 QUIT