PRSEEMP4 ;WIRMFO/JAH-STUDENT TRAINING REPORT BY SERVICE ;7/2/97
;;4.0;PAID;**25**;Sep 21, 1995
;
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SORT(PRDA) ;
;
;PRDA = ptr 2 file 200 from PAID EMPLOYEE file, (new person field).
;
I $E(IOST,1,2)="C-" S CLOCK=$$HUMDRUM^PRSLIB00(CLOCK,1)
;
;convert PRDA 2 name in file 200
S N1=$P($G(^VA(200,PRDA,0)),"^")
I N1="" D
.S N1="*"_EMPNAME,^TMP("EORM",$J,1)="* Names missing resolution from PAID EMPLOYEE file to the NEW PERSON file."
;
;create 0 node 4 everyone whether they have data or not
S ^TMP($J,SERVIEN,CCORG,EMPIEN,0)="0^^"_N1
S SSN=$P($G(^VA(200,+PRDA,1)),U,9)
I SSN="" S $P(^TMP($J,SERVIEN,CCORG,EMPIEN,0),"^",2)=0
Q:SSN=""
S PRDA(1)=+$O(^PRSPC("SSN",SSN,0))
;
;get job code & find it's readable 4mat.
S PRSETL=""
;job code = piece 17 of emp record or = 0 if no code is found.
S JOBCODE=$S($P($G(^PRSPC(PRDA(1),0)),U,17)'="":$P($G(^(0)),U,17),1:0)
;store job code & readable 4mat 4 later output
S PRSETL=$$EN12^PRSEUTL2(JOBCODE)
S $P(^TMP($J,SERVIEN,CCORG,EMPIEN,0),"^",2)=JOBCODE
I JOBCODE S ^TMP("JOBS",$J,JOBCODE)=PRSETL
;
;sort thru X-ref corresponding 2 training user asked 2 c.
;
I PRSESEL="L" F PRSE="C","O","W" D SORT1(PRSE) ;all but mandatory
;all but hospital wide OR all
I PRSESEL="H"!(PRSESEL="A") F PRSE="C","O","W","M" D SORT1(PRSE)
I PRSESEL'="A",PRSESEL'="L",PRSESEL'="H" D
. S PRSE=PRSESEL D SORT1(PRSE) ;single type
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
HWLIST ;build list of classes that are hospital wide
;
N SERV,MIIEN,CLSPTR,CLSMLT
;VARIABLES
; HWIDE() - RETURNED:
; = Subscripted by name of the class. Value is entry #s.
; SERV = service name in file 454.1
; MIEN = IEN in Mandatory Training Group file
; CLSPTR = Pointer to class file.
; CLSMLT = IENs in mandatory class multiple.
;
S MIEN=0
F S MIEN=$O(^PRSE(452.3,MIEN)) Q:MIEN'>0 D
. S SERV=$P($G(^PRSE(452.3,MIEN,0)),"^",2)
. I SERV'="",$P($G(^PRSP(454.1,SERV,0)),"^",1)="MISCELLANEOUS" D
.. S CLSMLT=0
.. F S CLSMLT=$O(^PRSE(452.3,MIEN,1,CLSMLT)) Q:CLSMLT'>0 D
... S CLSPTR=$G(^PRSE(452.3,MIEN,1,CLSMLT,0))
... I CLSPTR'="" S HWIDE(CLSPTR)=$P($G(^PRSE(452.1,CLSPTR,0)),"^",1)
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
HASHLIST ;Reverse array list 4 faster hashing in sort routine.
; i.e. change HWIDE(3)="DIVERSITY IN WP"... HWIDE("DIVERSITY IN WP")=3
;
S NODE=""
F S NODE=$O(HWIDE(NODE)) Q:NODE'>0 D
. I HWIDE(NODE)'="" S HWIDE(HWIDE(NODE))=NODE
. K HWIDE(NODE)
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SORT1(PRSE) ;Loop thru training data in AA x-ref & sort in2 ^TMP
;
; VARIABLES
; COUNT = # of classes, current type
; CRS = Course Title
; CURR = Current subtotl, all classes taken by employee
; NCD = Regular FM date
; NCD1 = Inverse FileMan date
; PRDA = Employee's IEN in file 200. (built into AA x-ref)
; PRSE = Type of training (mandatory, cont. educ)
; PRSECLS(0) = Ien of course in the PROGRAM CLASS file
; YRST,YREND = Start,end date range returned from DATSEL^PRSEUTL call.
;
N CRS,COUNT,CURR S COUNT=0
;
;outer loop thru courses (CRS) of type PRSE taken by employee (PRDA)
S CRS=""
F S CRS=$O(^PRSE(452,"AA",PRSE,PRDA,CRS)) Q:CRS="" D
. Q:'$D(^PRSE(452,"AA",PRSE,PRDA,CRS))
.;
. ;screen out hospital wide classes if user selected "H"
. I PRSESEL="H",$G(HWIDE(CRS))'="" Q
.;
.; loop thru dates that student took this class
. F NCD1=0:0 S NCD1=$O(^PRSE(452,"AA",PRSE,PRDA,CRS,NCD1)) Q:NCD1'>0 D
..; convert inverse FM date of class 2 FM date
.. S NCD=(9999999.0000-NCD1)
..;
..; get ien of the entry in the student education file.
.. S DA(2)=$O(^PRSE(452,"AA",PRSE,PRDA,CRS,NCD1,0))
.. Q:DA(2)'>0
.. S:$G(NSORT)="" NSORT=1
..;
..; quit if the class is outside selected date range
.. I (NCD>YREND)!(NCD<YRST) Q
..;
.. N X
.. S PRDATA=$G(^PRSE(452,DA(2),0))
.. S X=$G(^TMP($J,SERVIEN,CCORG,EMPIEN,"L",CRS))
.. I X="" D
... S X=NSORT,NSORT=NSORT+1
... S ^TMP($J,SERVIEN,CCORG,EMPIEN,"L",CRS)=X
..;
..; get ien of course in the PROGRAM CLASS file
.. S PRSECLS(0)=+$O(^PRSE(452.1,"B",CRS,0))
..;
..;
.. S ^TMP($J,SERVIEN,CCORG,EMPIEN,"L1",X,N1,NCD,DA(2))=$S(+$G(PRSECLS(0))>0:$P($G(^PRSE(452.1,PRSECLS(0),0)),U,3),1:$P(PRDATA,U,16))_U_$P(PRDATA,U,6)_U_$P(PRDATA,U,10)_U_$P(PRDATA,U,21)
..;
..;incremnt employee 0 node. Check later 2 c if no training occured.
..S COUNT=COUNT+1
;
;add class count to employees node
S CURR=$P(^TMP($J,SERVIEN,CCORG,EMPIEN,0),"^")
S $P(^TMP($J,SERVIEN,CCORG,EMPIEN,0),"^",1)=CURR+COUNT
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
;
OUTPUT(PRDA,POUT,JOBCODE,EMPNAME) ;
;routine loops thru tmp global, prints classes 4 1 employee.
N PRHLOC S POUT=0
;
;If class counter for employee is 0, write message and quit
I $P(^TMP($J,SERVIEN,CCORG,EMPIEN,0),"^",1)=0 D Q
. D NHDR^PRSEEMP4(JOBCODE,.POUT)
. W !,"NO DATA FOR EMPLOYEE: ",EMPNAME
. W:$G(PRSECLS)]"" !,"CLASS: ",PRSECLS
;
D NHDR^PRSEEMP4(JOBCODE,.POUT)
;
S NIC=""
F S NIC=$O(^TMP($J,SERVIEN,CCORG,EMPIEN,"L",NIC)) Q:NIC=""!POUT S NSORT=$G(^TMP($J,SERVIEN,CCORG,EMPIEN,"L",NIC)),HOLD=1 D:NSORT
.;
. S N1=""
. F S N1=$O(^TMP($J,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1)) Q:N1=""!POUT D
.. S NCD=""
.. F S NCD=$O(^TMP($J,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1,NCD)) Q:NCD=""!POUT D
... S DA=$O(^TMP($J,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1,NCD,0))
... Q:DA'>0
... I ('(NSW1>0)!($Y>(IOSL-7))) D NHDR(JOBCODE,.POUT) Q:POUT
... S PCOUNT=PCOUNT+1
... S PRDATA=$G(^TMP($J,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1,NCD,DA))
... S PHRS=(PHRS+$P(PRDATA,U))
... I $P(PRDATA,U,4)="C" D
.... S PHRS("CEU")=(PHRS("CEU")+$P(PRDATA,U,2))
.... S PHRS("CON")=(PHRS("CON")+$P(PRDATA,U,3))
... I HOLD=1 D
.... W !,$S(PRSE132:NIC,1:$E(NIC,1,25))
.... W:$P($G(^PRSE(452,DA,6)),U,2)'="" ?$S(PRSE132:55,1:27),$E($P(^(6),U,2),1,25)
.... W ?$S(PRSE132:93,1:47),"Length: "
.... W $S($P(PRDATA,U)>0:$J($P(PRDATA,U),4,2),1:"")
.... S HOLD=0
... S Y=$E(NCD,1,7) D:+Y D^DIQ W ?$S(PRSE132:114,1:67),$P(Y,"@"),!
... I $P(PRDATA,U,4)="C" W ?1,"CEUs: ",+$P(PRDATA,U,2),?$S(PRSE132:88,1:42),"Contact HRS: ",$J($P(PRDATA,U,3),4,2)
... Q
. S HOLD=1 Q
;
Q:POUT
W !,$$REPEAT^XLFSTR("-",$G(IOM))
;
;Output totals 4 1 employee.
W !,?1,"Total Classes: ",PCOUNT,?$S(PRSE132:78,1:35)
W "Total Length/Hours:",$J(PHRS,7,2)
;
;Display CEU totals if type of training sort criteria
;contains CEU classes.
I CEU D
. W !,?4,"Total CEUs:",$J(PHRS("CEU"),6,2),?$S(PRSE132:77,1:34)
. W "Total Contact Hours:",$J(PHRS("CON"),7,2)
;
W !,$$REPEAT^XLFSTR("-",$G(IOM))
;
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
NHDR(JOBCODE,POUT) ;
;
; NPC = page counter.
;
S POUT=0
N Z S Z=PRSESEL
;start a new page and a full header.
I $E(IOST,1,2)="C-" S POUT=$$ASK^PRSLIB00() Q:POUT
W @IOF S NPC=NPC+1
S PTAB=IOM-9
W $S(Z="L":"ALL BUT MANDATORY",Z="H":"ALL BUT HOSPITAL WIDE MANDATORY",Z="C":"C.E.",Z="M":"M.I.",Z="O":"OTHER",Z="W":"WARD",1:"COMPLETE")
W " TRAINING REPORT FOR "
W $S(TYP="C":"CY ",TYP="F":"FY ",1:" ")
W $S(TYP="C"!(TYP="F"):$G(PYR),1:$G(YRST(1))_" - "_$G(YREND(1)))
W ?PTAB,"PAGE: ",NPC
W !
W "Service: ",$S(PRSE132:SERVICE,1:$E(SERVICE,1,16))
W " Cost Ctr./Org.: ",$E(CCORG,1,4),":",$E(CCORG,5,8)
S Y=REPDT D:+Y D^DIQ W ?(IOM-13),Y
;
;print employees name and title portion of header
W !,"Name: ",$S(PRSE132:EMPNAME,1:$E(EMPNAME,1,20))
W " Title: "
;decipher job code from temporary table
S PRSETL=$G(^TMP("JOBS",$J,JOBCODE))
W $S(PRSETL="":"<Unknown>",1:$S(PRSE132:$E(PRSETL,1,40),1:$E(PRSETL,1,20)))
I PRSE132 D
.W !,"Class Name",?55,"Class Presenter",?114,"Date"
E D
.W !,"Class Name",?30,"Class Presenter",?67,"Date"
S NI="",$P(NI,"-",$S(PRSE132:133,1:81))=""
W !,NI
Q:$O(^TMP($J,SERVIEN,CCORG,EMPIEN,"L",""))=""
S (HOLD,NSW1)=1
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
EXIT K ^TMP($J),^TMP("JOBS",$J),^TMP("EORM",$J) D CLOSE^PRSEUTL,^PRSEKILL
Q
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEEMP4 8489 printed Apr 09, 2024@21:27:38 Page 2
PRSEEMP4 ;WIRMFO/JAH-STUDENT TRAINING REPORT BY SERVICE ;7/2/97
+1 ;;4.0;PAID;**25**;Sep 21, 1995
+2 ;
+3 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SORT(PRDA) ;
+1 ;
+2 ;PRDA = ptr 2 file 200 from PAID EMPLOYEE file, (new person field).
+3 ;
+4 IF $EXTRACT(IOST,1,2)="C-"
SET CLOCK=$$HUMDRUM^PRSLIB00(CLOCK,1)
+5 ;
+6 ;convert PRDA 2 name in file 200
+7 SET N1=$PIECE($GET(^VA(200,PRDA,0)),"^")
+8 IF N1=""
Begin DoDot:1
+9 SET N1="*"_EMPNAME
SET ^TMP("EORM",$JOB,1)="* Names missing resolution from PAID EMPLOYEE file to the NEW PERSON file."
End DoDot:1
+10 ;
+11 ;create 0 node 4 everyone whether they have data or not
+12 SET ^TMP($JOB,SERVIEN,CCORG,EMPIEN,0)="0^^"_N1
+13 SET SSN=$PIECE($GET(^VA(200,+PRDA,1)),U,9)
+14 IF SSN=""
SET $PIECE(^TMP($JOB,SERVIEN,CCORG,EMPIEN,0),"^",2)=0
+15 if SSN=""
QUIT
+16 SET PRDA(1)=+$ORDER(^PRSPC("SSN",SSN,0))
+17 ;
+18 ;get job code & find it's readable 4mat.
+19 SET PRSETL=""
+20 ;job code = piece 17 of emp record or = 0 if no code is found.
+21 SET JOBCODE=$SELECT($PIECE($GET(^PRSPC(PRDA(1),0)),U,17)'="":$PIECE($GET(^(0)),U,17),1:0)
+22 ;store job code & readable 4mat 4 later output
+23 SET PRSETL=$$EN12^PRSEUTL2(JOBCODE)
+24 SET $PIECE(^TMP($JOB,SERVIEN,CCORG,EMPIEN,0),"^",2)=JOBCODE
+25 IF JOBCODE
SET ^TMP("JOBS",$JOB,JOBCODE)=PRSETL
+26 ;
+27 ;sort thru X-ref corresponding 2 training user asked 2 c.
+28 ;
+29 ;all but mandatory
IF PRSESEL="L"
FOR PRSE="C","O","W"
DO SORT1(PRSE)
+30 ;all but hospital wide OR all
+31 IF PRSESEL="H"!(PRSESEL="A")
FOR PRSE="C","O","W","M"
DO SORT1(PRSE)
+32 IF PRSESEL'="A"
IF PRSESEL'="L"
IF PRSESEL'="H"
Begin DoDot:1
+33 ;single type
SET PRSE=PRSESEL
DO SORT1(PRSE)
End DoDot:1
+34 QUIT
+35 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
HWLIST ;build list of classes that are hospital wide
+1 ;
+2 NEW SERV,MIIEN,CLSPTR,CLSMLT
+3 ;VARIABLES
+4 ; HWIDE() - RETURNED:
+5 ; = Subscripted by name of the class. Value is entry #s.
+6 ; SERV = service name in file 454.1
+7 ; MIEN = IEN in Mandatory Training Group file
+8 ; CLSPTR = Pointer to class file.
+9 ; CLSMLT = IENs in mandatory class multiple.
+10 ;
+11 SET MIEN=0
+12 FOR
SET MIEN=$ORDER(^PRSE(452.3,MIEN))
if MIEN'>0
QUIT
Begin DoDot:1
+13 SET SERV=$PIECE($GET(^PRSE(452.3,MIEN,0)),"^",2)
+14 IF SERV'=""
IF $PIECE($GET(^PRSP(454.1,SERV,0)),"^",1)="MISCELLANEOUS"
Begin DoDot:2
+15 SET CLSMLT=0
+16 FOR
SET CLSMLT=$ORDER(^PRSE(452.3,MIEN,1,CLSMLT))
if CLSMLT'>0
QUIT
Begin DoDot:3
+17 SET CLSPTR=$GET(^PRSE(452.3,MIEN,1,CLSMLT,0))
+18 IF CLSPTR'=""
SET HWIDE(CLSPTR)=$PIECE($GET(^PRSE(452.1,CLSPTR,0)),"^",1)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
HASHLIST ;Reverse array list 4 faster hashing in sort routine.
+1 ; i.e. change HWIDE(3)="DIVERSITY IN WP"... HWIDE("DIVERSITY IN WP")=3
+2 ;
+3 SET NODE=""
+4 FOR
SET NODE=$ORDER(HWIDE(NODE))
if NODE'>0
QUIT
Begin DoDot:1
+5 IF HWIDE(NODE)'=""
SET HWIDE(HWIDE(NODE))=NODE
+6 KILL HWIDE(NODE)
End DoDot:1
+7 QUIT
+8 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SORT1(PRSE) ;Loop thru training data in AA x-ref & sort in2 ^TMP
+1 ;
+2 ; VARIABLES
+3 ; COUNT = # of classes, current type
+4 ; CRS = Course Title
+5 ; CURR = Current subtotl, all classes taken by employee
+6 ; NCD = Regular FM date
+7 ; NCD1 = Inverse FileMan date
+8 ; PRDA = Employee's IEN in file 200. (built into AA x-ref)
+9 ; PRSE = Type of training (mandatory, cont. educ)
+10 ; PRSECLS(0) = Ien of course in the PROGRAM CLASS file
+11 ; YRST,YREND = Start,end date range returned from DATSEL^PRSEUTL call.
+12 ;
+13 NEW CRS,COUNT,CURR
SET COUNT=0
+14 ;
+15 ;outer loop thru courses (CRS) of type PRSE taken by employee (PRDA)
+16 SET CRS=""
+17 FOR
SET CRS=$ORDER(^PRSE(452,"AA",PRSE,PRDA,CRS))
if CRS=""
QUIT
Begin DoDot:1
+18 if '$DATA(^PRSE(452,"AA",PRSE,PRDA,CRS))
QUIT
+19 ;
+20 ;screen out hospital wide classes if user selected "H"
+21 IF PRSESEL="H"
IF $GET(HWIDE(CRS))'=""
QUIT
+22 ;
+23 ; loop thru dates that student took this class
+24 FOR NCD1=0:0
SET NCD1=$ORDER(^PRSE(452,"AA",PRSE,PRDA,CRS,NCD1))
if NCD1'>0
QUIT
Begin DoDot:2
+25 ; convert inverse FM date of class 2 FM date
+26 SET NCD=(9999999.0000-NCD1)
+27 ;
+28 ; get ien of the entry in the student education file.
+29 SET DA(2)=$ORDER(^PRSE(452,"AA",PRSE,PRDA,CRS,NCD1,0))
+30 if DA(2)'>0
QUIT
+31 if $GET(NSORT)=""
SET NSORT=1
+32 ;
+33 ; quit if the class is outside selected date range
+34 IF (NCD>YREND)!(NCD<YRST)
QUIT
+35 ;
+36 NEW X
+37 SET PRDATA=$GET(^PRSE(452,DA(2),0))
+38 SET X=$GET(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L",CRS))
+39 IF X=""
Begin DoDot:3
+40 SET X=NSORT
SET NSORT=NSORT+1
+41 SET ^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L",CRS)=X
End DoDot:3
+42 ;
+43 ; get ien of course in the PROGRAM CLASS file
+44 SET PRSECLS(0)=+$ORDER(^PRSE(452.1,"B",CRS,0))
+45 ;
+46 ;
+47 SET ^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L1",X,N1,NCD,DA(2))=$SELECT(+$GET(PRSECLS(0))>0:$PIECE($GET(^PRSE(452.1,PRSECLS(0),0)),U,3),1:$PIECE(PRDATA,U,16))_U_$PIECE(PRDATA,U,6)_U_$PIECE(PRDATA,U,10)_U_$PIECE(PRDATA,U,21)
+48 ;
+49 ;incremnt employee 0 node. Check later 2 c if no training occured.
+50 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+51 ;
+52 ;add class count to employees node
+53 SET CURR=$PIECE(^TMP($JOB,SERVIEN,CCORG,EMPIEN,0),"^")
+54 SET $PIECE(^TMP($JOB,SERVIEN,CCORG,EMPIEN,0),"^",1)=CURR+COUNT
+55 QUIT
+56 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+57 ;
OUTPUT(PRDA,POUT,JOBCODE,EMPNAME) ;
+1 ;routine loops thru tmp global, prints classes 4 1 employee.
+2 NEW PRHLOC
SET POUT=0
+3 ;
+4 ;If class counter for employee is 0, write message and quit
+5 IF $PIECE(^TMP($JOB,SERVIEN,CCORG,EMPIEN,0),"^",1)=0
Begin DoDot:1
+6 DO NHDR^PRSEEMP4(JOBCODE,.POUT)
+7 WRITE !,"NO DATA FOR EMPLOYEE: ",EMPNAME
+8 if $GET(PRSECLS)]""
WRITE !,"CLASS: ",PRSECLS
End DoDot:1
QUIT
+9 ;
+10 DO NHDR^PRSEEMP4(JOBCODE,.POUT)
+11 ;
+12 SET NIC=""
+13 FOR
SET NIC=$ORDER(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L",NIC))
if NIC=""!POUT
QUIT
SET NSORT=$GET(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L",NIC))
SET HOLD=1
if NSORT
Begin DoDot:1
+14 ;
+15 SET N1=""
+16 FOR
SET N1=$ORDER(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1))
if N1=""!POUT
QUIT
Begin DoDot:2
+17 SET NCD=""
+18 FOR
SET NCD=$ORDER(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1,NCD))
if NCD=""!POUT
QUIT
Begin DoDot:3
+19 SET DA=$ORDER(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1,NCD,0))
+20 if DA'>0
QUIT
+21 IF ('(NSW1>0)!($Y>(IOSL-7)))
DO NHDR(JOBCODE,.POUT)
if POUT
QUIT
+22 SET PCOUNT=PCOUNT+1
+23 SET PRDATA=$GET(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L1",NSORT,N1,NCD,DA))
+24 SET PHRS=(PHRS+$PIECE(PRDATA,U))
+25 IF $PIECE(PRDATA,U,4)="C"
Begin DoDot:4
+26 SET PHRS("CEU")=(PHRS("CEU")+$PIECE(PRDATA,U,2))
+27 SET PHRS("CON")=(PHRS("CON")+$PIECE(PRDATA,U,3))
End DoDot:4
+28 IF HOLD=1
Begin DoDot:4
+29 WRITE !,$SELECT(PRSE132:NIC,1:$EXTRACT(NIC,1,25))
+30 if $PIECE($GET(^PRSE(452,DA,6)),U,2)'=""
WRITE ?$SELECT(PRSE132:55,1:27),$EXTRACT($PIECE(^(6),U,2),1,25)
+31 WRITE ?$SELECT(PRSE132:93,1:47),"Length: "
+32 WRITE $SELECT($PIECE(PRDATA,U)>0:$JUSTIFY($PIECE(PRDATA,U),4,2),1:"")
+33 SET HOLD=0
End DoDot:4
+34 SET Y=$EXTRACT(NCD,1,7)
if +Y
DO D^DIQ
WRITE ?$SELECT(PRSE132:114,1:67),$PIECE(Y,"@"),!
+35 IF $PIECE(PRDATA,U,4)="C"
WRITE ?1,"CEUs: ",+$PIECE(PRDATA,U,2),?$SELECT(PRSE132:88,1:42),"Contact HRS: ",$JUSTIFY($PIECE(PRDATA,U,3),4,2)
+36 QUIT
End DoDot:3
End DoDot:2
+37 SET HOLD=1
QUIT
End DoDot:1
+38 ;
+39 if POUT
QUIT
+40 WRITE !,$$REPEAT^XLFSTR("-",$GET(IOM))
+41 ;
+42 ;Output totals 4 1 employee.
+43 WRITE !,?1,"Total Classes: ",PCOUNT,?$SELECT(PRSE132:78,1:35)
+44 WRITE "Total Length/Hours:",$JUSTIFY(PHRS,7,2)
+45 ;
+46 ;Display CEU totals if type of training sort criteria
+47 ;contains CEU classes.
+48 IF CEU
Begin DoDot:1
+49 WRITE !,?4,"Total CEUs:",$JUSTIFY(PHRS("CEU"),6,2),?$SELECT(PRSE132:77,1:34)
+50 WRITE "Total Contact Hours:",$JUSTIFY(PHRS("CON"),7,2)
End DoDot:1
+51 ;
+52 WRITE !,$$REPEAT^XLFSTR("-",$GET(IOM))
+53 ;
+54 QUIT
+55 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
NHDR(JOBCODE,POUT) ;
+1 ;
+2 ; NPC = page counter.
+3 ;
+4 SET POUT=0
+5 NEW Z
SET Z=PRSESEL
+6 ;start a new page and a full header.
+7 IF $EXTRACT(IOST,1,2)="C-"
SET POUT=$$ASK^PRSLIB00()
if POUT
QUIT
+8 WRITE @IOF
SET NPC=NPC+1
+9 SET PTAB=IOM-9
+10 WRITE $SELECT(Z="L":"ALL BUT MANDATORY",Z="H":"ALL BUT HOSPITAL WIDE MANDATORY",Z="C":"C.E.",Z="M":"M.I.",Z="O":"OTHER",Z="W":"WARD",1:"COMPLETE")
+11 WRITE " TRAINING REPORT FOR "
+12 WRITE $SELECT(TYP="C":"CY ",TYP="F":"FY ",1:" ")
+13 WRITE $SELECT(TYP="C"!(TYP="F"):$GET(PYR),1:$GET(YRST(1))_" - "_$GET(YREND(1)))
+14 WRITE ?PTAB,"PAGE: ",NPC
+15 WRITE !
+16 WRITE "Service: ",$SELECT(PRSE132:SERVICE,1:$EXTRACT(SERVICE,1,16))
+17 WRITE " Cost Ctr./Org.: ",$EXTRACT(CCORG,1,4),":",$EXTRACT(CCORG,5,8)
+18 SET Y=REPDT
if +Y
DO D^DIQ
WRITE ?(IOM-13),Y
+19 ;
+20 ;print employees name and title portion of header
+21 WRITE !,"Name: ",$SELECT(PRSE132:EMPNAME,1:$EXTRACT(EMPNAME,1,20))
+22 WRITE " Title: "
+23 ;decipher job code from temporary table
+24 SET PRSETL=$GET(^TMP("JOBS",$JOB,JOBCODE))
+25 WRITE $SELECT(PRSETL="":"<Unknown>",1:$SELECT(PRSE132:$EXTRACT(PRSETL,1,40),1:$EXTRACT(PRSETL,1,20)))
+26 IF PRSE132
Begin DoDot:1
+27 WRITE !,"Class Name",?55,"Class Presenter",?114,"Date"
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 WRITE !,"Class Name",?30,"Class Presenter",?67,"Date"
End DoDot:1
+30 SET NI=""
SET $PIECE(NI,"-",$SELECT(PRSE132:133,1:81))=""
+31 WRITE !,NI
+32 if $ORDER(^TMP($JOB,SERVIEN,CCORG,EMPIEN,"L",""))=""
QUIT
+33 SET (HOLD,NSW1)=1
+34 QUIT
+35 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
EXIT KILL ^TMP($JOB),^TMP("JOBS",$JOB),^TMP("EORM",$JOB)
DO CLOSE^PRSEUTL
DO ^PRSEKILL
+1 QUIT
+2 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
