PRSNRLND ;WOIFO/KJS - LOCATION Non Direct Care Summary by Skill Mix II REPORT ;12-9-2011
;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
COORD ;Entry point for VANOD Coordinator
; Coordinator has no access limits so let them pick any group
N GROUP
D PIKGROUP^PRSNUT04(.GROUP,"N",1)
I $P($G(GROUP(0)),U,2)="E" D Q
.W !,$P(GROUP(0),U,3)
D MAIN
;
Q
;
MAIN ;
N RANGE,BEG,END,EXTBEG,EXTEND,STOP,TYPE,BEG,END
S STOP=0
D DATE
Q:STOP
D QUE
Q
;
REPORT ;for group of location or t&l
;
N PRSIEN,PRSNG,PICK,PG,LOCIEN,PRSNVER,PRSNTS,PRSNDAY,PPIEN,ENDPP,ENDDAY,BEGPP,BEGDAY,TODAY,PG,TIMEREC
N PRSNAME,PRSNSSN,PRSNTL,SKILMIX,PRSL,PRSNDAYS,PRSNDATE
N PRSNST,PRSNSP,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
N PRSNTW,PRSNTWD,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL
N PRSNLNG,IEN200,PRIMLOC,PRSNARY,LOCNAM,NUROLE
U IO
S PG=0,TODAY=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
S BEGPP=$G(^PRST(458,"AD",BEG)),BEGDAY=$P(BEGPP,U,2),BEGPP=+BEGPP
S ENDPP=$G(^PRST(458,"AD",END)),ENDDAY=$P(ENDPP,U,2),ENDPP=+ENDPP
D HDR
S (PICK,STOP)=0
F S PICK=$O(GROUP(PICK)) Q:PICK=""!STOP D
. S PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
. S LOCIEN=+GROUP(PICK)
. S LOCNAM=$P($$ISACTIVE^PRSNUT01(DT,LOCIEN),U,2)
. S PRSIEN=0
. F S PRSIEN=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN)) Q:'PRSIEN!STOP D
.. D INFO
.. S PPIEN=BEGPP-1
.. F S PPIEN=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN)) Q:'PPIEN!STOP!(PPIEN>ENDPP) D
... S PRSNDAYS=$G(^PRST(458,PPIEN,1))
... S PRSNDAY=$S(PPIEN=BEGPP:BEGDAY-1,1:0)
... F S PRSNDAY=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY)) Q:'PRSNDAY!STOP!(PPIEN=ENDPP&(PRSNDAY>ENDDAY)) D
.... S PRSNDATE=$P(PRSNDAYS,U,PRSNDAY),PRSNDATE=$E(PRSNDATE,4,5)_"/"_$E(PRSNDATE,6,7)_"/"_$E(PRSNDATE,2,3)
.... S PRSNVER=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,""),-1)
.... S PRSNTS=0,PRSD=1
.... F S PRSNTS=$O(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,PRSNVER,PRSNTS)) Q:'PRSNTS!STOP D
..... S TIMEREC=$G(^PRSN(451,PPIEN,"E",PRSIEN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNTS,0))
..... D DATA
D PRTLP
W !!,"End of Report"
D ^%ZISC
Q
;
DATE ; User is prompted for a date range
;
S RANGE=$$POCRANGE^PRSNUT01()
; QUIT HERE IF RANGE=0
I +$G(RANGE)'>0 S STOP=1 Q
;
S BEG=$P(RANGE,U)
S END=$P(RANGE,U,2)
S EXTBEG=$P(RANGE,U,3)
S EXTEND=$P(RANGE,U,4)
;
Q
;
QUE ;call to generate and display report for individual activity
N %ZIS,POP,IOP
S %ZIS="MQ"
D ^%ZIS
Q:POP
I $D(IO("Q")) D
. K IO("Q")
. N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
. S ZTDESC="LOCATION NON DIRECT CARE SUMMARY BY SKILLMIX"
. S ZTRTN="REPORT^PRSNRLND"
. S ZTSAVE("GROUP")=""
. S ZTSAVE("GROUP(")=""
. S ZTSAVE("TYPE")=""
. S ZTSAVE("BEG")=""
. S ZTSAVE("END")=""
. S ZTSAVE("EXTBEG")=""
. S ZTSAVE("EXTEND")=""
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D
. D REPORT
Q
;
INFO ;Find nurse information to display in report
;
S PRSL=1
S PRSNARY=$G(^PRSPC(PRSIEN,0))
S PRSNAME=$P(PRSNARY,U) ;Nurse Name
S PRSNSSN=$P(PRSNARY,U,9) ;Nurse SSN
S PRSNTL=$P(PRSNARY,U,8) ;Nurse T&L
S NUROLE=$P($$ISNURSE^PRSNUT01(PRSIEN),U,2) ; Nurse skillmix
S IEN200=$G(^PRSPC(PRSIEN,200))
S PRIMLOC=$S(IEN200="":"",1:$$PRIMLOC^PRSNUT03(IEN200))
Q
;
DATA ;Extract display data from POCD array
;
;Start Time
S PRSNST=$P(TIMEREC,U)
;
;Stop Time
S PRSNSP=$P(TIMEREC,U,2)
;
;Meal Time
S MEAL=$P(TIMEREC,U,3)
;
;Get hours worked in a given location
S HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
;
;Type of Time code IEN
S PRSNTT=$P(TIMEREC,U,4),PRSNLNG=" "
I PRSNTT'="" D
. ;
. ;Type of Time code
. S PRSNTIEN=$O(^PRST(457.3,"B",PRSNTT,0))
. Q:PRSNTIEN=""
. ;
. ;Description for Type of Time code
. S PRSNLNG=$P(^PRST(457.3,PRSNTIEN,0),U,2)
. ;
. ;Type of Work Code IEN
S PRSNWIEN=$P(TIMEREC,U,6),PRSNTW=" ",PRSNTWD=" "
I PRSNWIEN'="" D
. ;
. ;Type of Work Code
. S PRSNTW=$P(^PRSN(451.5,PRSNWIEN,0),U)
. ;
. ;Description for Type of Work code
. S PRSNTWD=$P(^PRSN(451.5,PRSNWIEN,0),U,2)
;
;OT Mandatory/Voluntary
S PRSNM=$P(TIMEREC,U,7)
;
;save skill mix, hours and type of work into SKILMIX array
;
; Patch PRS*4.0*142 gives variables PRSNTWD and NUROLE the value of a space in the event that they are set to null.
I $G(PRSNTW)'="DC" D
. S:PRSNTWD="" PRSNTWD=" " S:NUROLE="" NUROLE=" "
. S SKILMIX(LOCNAM,PRSNTWD,NUROLE)=$G(SKILMIX(LOCNAM,PRSNTWD,NUROLE))+HOURS
Q
;
HDR ;
;
W @IOF
S PG=PG+1
W ?17,"LOCATION 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 ;Order through SKILMIX array, total data & display
N RNDC,LNDC,UNDC,GP,TNDC,SKILL,NDCARE
S GP=""
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=SKILMIX(GP,NDCARE,SKILL)+$G(RNDC)
... I SKILL["LPN" S LNDC=SKILMIX(GP,NDCARE,SKILL)+$G(LNDC)
... I SKILL'["RN",SKILL'["LPN" S UNDC=SKILMIX(GP,NDCARE,SKILL)+$G(UNDC)
.. S TNDC=$G(RNDC)+$G(LNDC)+$G(UNDC) ;total hours
.. D PPP
Q
;
PPP ;
W !
W GP,?22,NDCARE,?53,RNDC,?60,LNDC,?67,UNDC,?74,TNDC
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRLND 5821 printed Apr 09, 2024@21:30:27 Page 2
PRSNRLND ;WOIFO/KJS - LOCATION Non Direct Care Summary by Skill Mix II REPORT ;12-9-2011
+1 ;;4.0;PAID;**126,142**;Sep 21, 1995;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
COORD ;Entry point for VANOD Coordinator
+1 ; Coordinator has no access limits so let them pick any group
+2 NEW GROUP
+3 DO PIKGROUP^PRSNUT04(.GROUP,"N",1)
+4 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+5 WRITE !,$PIECE(GROUP(0),U,3)
End DoDot:1
QUIT
+6 DO MAIN
+7 ;
+8 QUIT
+9 ;
MAIN ;
+1 NEW RANGE,BEG,END,EXTBEG,EXTEND,STOP,TYPE,BEG,END
+2 SET STOP=0
+3 DO DATE
+4 if STOP
QUIT
+5 DO QUE
+6 QUIT
+7 ;
REPORT ;for group of location or t&l
+1 ;
+2 NEW PRSIEN,PRSNG,PICK,PG,LOCIEN,PRSNVER,PRSNTS,PRSNDAY,PPIEN,ENDPP,ENDDAY,BEGPP,BEGDAY,TODAY,PG,TIMEREC
+3 NEW PRSNAME,PRSNSSN,PRSNTL,SKILMIX,PRSL,PRSNDAYS,PRSNDATE
+4 NEW PRSNST,PRSNSP,PRSNTT,PRSNWIEN,HOURS,PRSNTIEN
+5 NEW PRSNTW,PRSNTWD,PRSNM,PRSNRE,PRSNREC,PRSNRIEN,MEAL
+6 NEW PRSNLNG,IEN200,PRIMLOC,PRSNARY,LOCNAM,NUROLE
+7 USE IO
+8 SET PG=0
SET TODAY=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+9 SET BEGPP=$GET(^PRST(458,"AD",BEG))
SET BEGDAY=$PIECE(BEGPP,U,2)
SET BEGPP=+BEGPP
+10 SET ENDPP=$GET(^PRST(458,"AD",END))
SET ENDDAY=$PIECE(ENDPP,U,2)
SET ENDPP=+ENDPP
+11 DO HDR
+12 SET (PICK,STOP)=0
+13 FOR
SET PICK=$ORDER(GROUP(PICK))
if PICK=""!STOP
QUIT
Begin DoDot:1
+14 SET PRSNG=GROUP(0)_"^"_PICK_"^"_GROUP(PICK)
+15 SET LOCIEN=+GROUP(PICK)
+16 SET LOCNAM=$PIECE($$ISACTIVE^PRSNUT01(DT,LOCIEN),U,2)
+17 SET PRSIEN=0
+18 FOR
SET PRSIEN=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN))
if 'PRSIEN!STOP
QUIT
Begin DoDot:2
+19 DO INFO
+20 SET PPIEN=BEGPP-1
+21 FOR
SET PPIEN=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN))
if 'PPIEN!STOP!(PPIEN>ENDPP)
QUIT
Begin DoDot:3
+22 SET PRSNDAYS=$GET(^PRST(458,PPIEN,1))
+23 SET PRSNDAY=$SELECT(PPIEN=BEGPP:BEGDAY-1,1:0)
+24 FOR
SET PRSNDAY=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY))
if 'PRSNDAY!STOP!(PPIEN=ENDPP&(PRSNDAY>ENDDAY))
QUIT
Begin DoDot:4
+25 SET PRSNDATE=$PIECE(PRSNDAYS,U,PRSNDAY)
SET PRSNDATE=$EXTRACT(PRSNDATE,4,5)_"/"_$EXTRACT(PRSNDATE,6,7)_"/"_$EXTRACT(PRSNDATE,2,3)
+26 SET PRSNVER=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,""),-1)
+27 SET PRSNTS=0
SET PRSD=1
+28 FOR
SET PRSNTS=$ORDER(^PRSN(451,"ALN",LOCIEN,PRSIEN,PPIEN,PRSNDAY,PRSNVER,PRSNTS))
if 'PRSNTS!STOP
QUIT
Begin DoDot:5
+29 SET TIMEREC=$GET(^PRSN(451,PPIEN,"E",PRSIEN,"D",PRSNDAY,"V",PRSNVER,"T",PRSNTS,0))
+30 DO DATA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 DO PRTLP
+32 WRITE !!,"End of Report"
+33 DO ^%ZISC
+34 QUIT
+35 ;
DATE ; User is prompted for a date range
+1 ;
+2 SET RANGE=$$POCRANGE^PRSNUT01()
+3 ; QUIT HERE IF RANGE=0
+4 IF +$GET(RANGE)'>0
SET STOP=1
QUIT
+5 ;
+6 SET BEG=$PIECE(RANGE,U)
+7 SET END=$PIECE(RANGE,U,2)
+8 SET EXTBEG=$PIECE(RANGE,U,3)
+9 SET EXTEND=$PIECE(RANGE,U,4)
+10 ;
+11 QUIT
+12 ;
QUE ;call to generate and display report for individual activity
+1 NEW %ZIS,POP,IOP
+2 SET %ZIS="MQ"
+3 DO ^%ZIS
+4 if POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 KILL IO("Q")
+7 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+8 SET ZTDESC="LOCATION NON DIRECT CARE SUMMARY BY SKILLMIX"
+9 SET ZTRTN="REPORT^PRSNRLND"
+10 SET ZTSAVE("GROUP")=""
+11 SET ZTSAVE("GROUP(")=""
+12 SET ZTSAVE("TYPE")=""
+13 SET ZTSAVE("BEG")=""
+14 SET ZTSAVE("END")=""
+15 SET ZTSAVE("EXTBEG")=""
+16 SET ZTSAVE("EXTEND")=""
+17 DO ^%ZTLOAD
+18 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 DO REPORT
End DoDot:1
+21 QUIT
+22 ;
INFO ;Find nurse information to display in report
+1 ;
+2 SET PRSL=1
+3 SET PRSNARY=$GET(^PRSPC(PRSIEN,0))
+4 ;Nurse Name
SET PRSNAME=$PIECE(PRSNARY,U)
+5 ;Nurse SSN
SET PRSNSSN=$PIECE(PRSNARY,U,9)
+6 ;Nurse T&L
SET PRSNTL=$PIECE(PRSNARY,U,8)
+7 ; Nurse skillmix
SET NUROLE=$PIECE($$ISNURSE^PRSNUT01(PRSIEN),U,2)
+8 SET IEN200=$GET(^PRSPC(PRSIEN,200))
+9 SET PRIMLOC=$SELECT(IEN200="":"",1:$$PRIMLOC^PRSNUT03(IEN200))
+10 QUIT
+11 ;
DATA ;Extract display data from POCD array
+1 ;
+2 ;Start Time
+3 SET PRSNST=$PIECE(TIMEREC,U)
+4 ;
+5 ;Stop Time
+6 SET PRSNSP=$PIECE(TIMEREC,U,2)
+7 ;
+8 ;Meal Time
+9 SET MEAL=$PIECE(TIMEREC,U,3)
+10 ;
+11 ;Get hours worked in a given location
+12 SET HOURS=$$AMT^PRSPSAPU(PRSNST,PRSNSP,MEAL)
+13 ;
+14 ;Type of Time code IEN
+15 SET PRSNTT=$PIECE(TIMEREC,U,4)
SET PRSNLNG=" "
+16 IF PRSNTT'=""
Begin DoDot:1
+17 ;
+18 ;Type of Time code
+19 SET PRSNTIEN=$ORDER(^PRST(457.3,"B",PRSNTT,0))
+20 if PRSNTIEN=""
QUIT
+21 ;
+22 ;Description for Type of Time code
+23 SET PRSNLNG=$PIECE(^PRST(457.3,PRSNTIEN,0),U,2)
+24 ;
+25 ;Type of Work Code IEN
End DoDot:1
+26 SET PRSNWIEN=$PIECE(TIMEREC,U,6)
SET PRSNTW=" "
SET PRSNTWD=" "
+27 IF PRSNWIEN'=""
Begin DoDot:1
+28 ;
+29 ;Type of Work Code
+30 SET PRSNTW=$PIECE(^PRSN(451.5,PRSNWIEN,0),U)
+31 ;
+32 ;Description for Type of Work code
+33 SET PRSNTWD=$PIECE(^PRSN(451.5,PRSNWIEN,0),U,2)
End DoDot:1
+34 ;
+35 ;OT Mandatory/Voluntary
+36 SET PRSNM=$PIECE(TIMEREC,U,7)
+37 ;
+38 ;save skill mix, hours and type of work into SKILMIX array
+39 ;
+40 ; Patch PRS*4.0*142 gives variables PRSNTWD and NUROLE the value of a space in the event that they are set to null.
+41 IF $GET(PRSNTW)'="DC"
Begin DoDot:1
+42 if PRSNTWD=""
SET PRSNTWD=" "
if NUROLE=""
SET NUROLE=" "
+43 SET SKILMIX(LOCNAM,PRSNTWD,NUROLE)=$GET(SKILMIX(LOCNAM,PRSNTWD,NUROLE))+HOURS
End DoDot:1
+44 QUIT
+45 ;
HDR ;
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE ?17,"LOCATION 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
+13 ;
PRTLP ;Order through SKILMIX array, total data & display
+1 NEW RNDC,LNDC,UNDC,GP,TNDC,SKILL,NDCARE
+2 SET GP=""
+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=SKILMIX(GP,NDCARE,SKILL)+$GET(RNDC)
+10 IF SKILL["LPN"
SET LNDC=SKILMIX(GP,NDCARE,SKILL)+$GET(LNDC)
+11 IF SKILL'["RN"
IF SKILL'["LPN"
SET UNDC=SKILMIX(GP,NDCARE,SKILL)+$GET(UNDC)
End DoDot:3
+12 ;total hours
SET TNDC=$GET(RNDC)+$GET(LNDC)+$GET(UNDC)
+13 DO PPP
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
PPP ;
+1 WRITE !
+2 WRITE GP,?22,NDCARE,?53,RNDC,?60,LNDC,?67,UNDC,?74,TNDC
+3 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+4 QUIT
