PRSNRGD1 ;WOIFO/KJS - Nursing LOCATION DETAIL Report II;08022011
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
DSPLY(PRSIEN,NURSE,STOP) ; Entry point to gather POC Nurse
; Education Data from file 450
;INPUT:
; PRSIEN: Nurse ien 450
; BEG,END: FileMan begin and end dates for report
;
D INFO^PRSNRAS1
N INDEX,CNT
S (INDEX,CNT)=0
D DATA(PRSIEN,NURSE,.STOP)
;
K PRSNAME,PRSNSSN,PRSNTL,SKILMIX,ROLE,PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
K PPIEN,PRSL,PRSNDAY,STARTDT,STDE,BOC,OCC,ASN,EDU,YEAR
Q
;
;
HDR ;Display header
;
W @IOF
S PG=PG+1
W "Nursing Location Detail Report"
W ?45,"Run Date: ",$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3)," Page: ",$J(PG,3)
W !!,"Nurse Name",?21,"SSN",?27,"Nurse Role",?48,"BOC",?52,"OCC",?58,"CC",?64,"Assign",?75,"Nurse"
W !,?64,"Code",?76,"FTEE"
W !,"--------------------------------------------------------------------------------"
;
QUIT
;
DATA(PRSIEN,NURSE,STOP) ;Extract display data from POCD array and get external date
;
N JOB,ED,A,B,PRSNA,ROLE
S (BOC,OCC,ASN,EDU,YEAR)=0
;
S ROLE=$P($G(NURSE),U,2)
S JOB=$$GETCODES^PRSNUT01(PRSIEN) ;Job codes
S BOC=$P(JOB,U)
S OCC=$P(JOB,U,2)
S ASN=$P(JOB,U,3)
S CC=$P(JOB,U,4)
S PRSNA=^PRSPC(PRSIEN,0),YEAR=$P(PRSNA,U,31) S:YEAR YEAR=$E(DT,1,3)-$E(YEAR,1,3)
S A=$P(PRSNA,U,29),B=$L(A),$P(PRSNA,U,29)=$S(A<1000:A,1:$E(A,1,B-6)_","_$E(A,B-5,B))
S A=$P(PRSNA,U,28),$P(PRSNA,U,28)=$E(A,4,5)_"/"_$E(A,6,7)_"/"_$E(A,2,3)
S NORHRS=$P(PRSNA,U,16)
S FTEE=NORHRS/80,TOTFTEE=TOTFTEE+FTEE,TOTNUR=TOTNUR+1
D PRT
;
QUIT
;
PRT ;
W !,$E(PRSNAME,1,19),?21,$E(PRSNSSN,6,9),?27,$E(ROLE,1,19),?48,BOC,?52,OCC,?58,CC,?64,ASN,?76,$J(FTEE,4,2)
;
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNRGD1 1849 printed Apr 09, 2024@21:28:59 Page 2
PRSNRGD1 ;WOIFO/KJS - Nursing LOCATION DETAIL Report II;08022011
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
DSPLY(PRSIEN,NURSE,STOP) ; Entry point to gather POC Nurse
+1 ; Education Data from file 450
+2 ;INPUT:
+3 ; PRSIEN: Nurse ien 450
+4 ; BEG,END: FileMan begin and end dates for report
+5 ;
+6 DO INFO^PRSNRAS1
+7 NEW INDEX,CNT
+8 SET (INDEX,CNT)=0
+9 DO DATA(PRSIEN,NURSE,.STOP)
+10 ;
+11 KILL PRSNAME,PRSNSSN,PRSNTL,SKILMIX,ROLE,PRSNLNG,PRSNTWD,PRSNPOC1,PRSDY
+12 KILL PPIEN,PRSL,PRSNDAY,STARTDT,STDE,BOC,OCC,ASN,EDU,YEAR
+13 QUIT
+14 ;
+15 ;
HDR ;Display header
+1 ;
+2 WRITE @IOF
+3 SET PG=PG+1
+4 WRITE "Nursing Location Detail Report"
+5 WRITE ?45,"Run Date: ",$EXTRACT(DT,4,5),"/",$EXTRACT(DT,6,7),"/",$EXTRACT(DT,2,3)," Page: ",$JUSTIFY(PG,3)
+6 WRITE !!,"Nurse Name",?21,"SSN",?27,"Nurse Role",?48,"BOC",?52,"OCC",?58,"CC",?64,"Assign",?75,"Nurse"
+7 WRITE !,?64,"Code",?76,"FTEE"
+8 WRITE !,"--------------------------------------------------------------------------------"
+9 ;
+10 QUIT
+11 ;
DATA(PRSIEN,NURSE,STOP) ;Extract display data from POCD array and get external date
+1 ;
+2 NEW JOB,ED,A,B,PRSNA,ROLE
+3 SET (BOC,OCC,ASN,EDU,YEAR)=0
+4 ;
+5 SET ROLE=$PIECE($GET(NURSE),U,2)
+6 ;Job codes
SET JOB=$$GETCODES^PRSNUT01(PRSIEN)
+7 SET BOC=$PIECE(JOB,U)
+8 SET OCC=$PIECE(JOB,U,2)
+9 SET ASN=$PIECE(JOB,U,3)
+10 SET CC=$PIECE(JOB,U,4)
+11 SET PRSNA=^PRSPC(PRSIEN,0)
SET YEAR=$PIECE(PRSNA,U,31)
if YEAR
SET YEAR=$EXTRACT(DT,1,3)-$EXTRACT(YEAR,1,3)
+12 SET A=$PIECE(PRSNA,U,29)
SET B=$LENGTH(A)
SET $PIECE(PRSNA,U,29)=$SELECT(A<1000:A,1:$EXTRACT(A,1,B-6)_","_$EXTRACT(A,B-5,B))
+13 SET A=$PIECE(PRSNA,U,28)
SET $PIECE(PRSNA,U,28)=$EXTRACT(A,4,5)_"/"_$EXTRACT(A,6,7)_"/"_$EXTRACT(A,2,3)
+14 SET NORHRS=$PIECE(PRSNA,U,16)
+15 SET FTEE=NORHRS/80
SET TOTFTEE=TOTFTEE+FTEE
SET TOTNUR=TOTNUR+1
+16 DO PRT
+17 ;
+18 QUIT
+19 ;
PRT ;
+1 WRITE !,$EXTRACT(PRSNAME,1,19),?21,$EXTRACT(PRSNSSN,6,9),?27,$EXTRACT(ROLE,1,19),?48,BOC,?52,OCC,?58,CC,?64,ASN,?76,$JUSTIFY(FTEE,4,2)
+2 ;
+3 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
+4 QUIT
