PRSEEMP1 ;HISC/JH-INDIVIDUAL INSERVICE ATTENDANCE REPORT ;9/17/1998
;;4.0;PAID;**20,44**;Sep 21, 1995
EN1 ; INDIVIDUAL STUDENT TRAINING REPORT
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
S (POUT,NPC,NQ,NSW1)=0,HOLD=1 D EN2^PRSEUTL3($G(DUZ)) I '(PRSESER>0) D MSG3^PRSEMSG G QUIT
W ! S DATSEL="N+" D DATSEL^PRSEUTL G:$G(POUT) QUIT D INS^PRSEUTL G QUIT:$G(POUT)
D:'(PRSESEL="A") EN5^PRSEUTL2 G Q:$G(POUT)
S DIC("S")="I +$$EN4^PRSEUTL3($G(DUZ))!(+$$EN6^PRSEUTL3($G(DUZ))&(+$$EN3^PRSEUTL3(+$G(Y))=PRSESER))!(DUZ(0)[""@"")"
I +$$EN4^PRSEUTL3($G(DUZ))!(+$$EN6^PRSEUTL3($G(DUZ)))!(DUZ(0)["@") W ! D EN6^PRSEUTL2 G:$G(POUT)!'(+Y>0) QUIT S PRDA=+Y
S:$G(PRDA)'>0 PRDA=DUZ
W ! S ZTRTN="START^PRSEEMP1",ZTDESC="INDIVIDUAL EMPLOYEE TRAINING REPORT" D L,DEV^PRSEUTL G:POP!($D(ZTSK)) QUIT
START ;
S (PHRS,PHRS("CEU"),PHRS("CON"),PCOUNT)=0,PRSE132=$S(IOM'<132:132,1:0) D SORT U IO
N PRHLOC
S X=$O(^TMP("PRSE",$J,"L","")) I X="" D NHDR W !,"THERE IS NO DATA FOR THIS REPORT" W !,"EMPLOYEE: ",$P($G(^VA(200,PRDA,0)),U) W:$G(PRSECLS)]"" !,"CLASS: ",PRSECLS W ! G QUIT
S PRSELOC="" F S PRSELOC=$O(^TMP("PRSE",$J,"L",PRSELOC)) Q:PRSELOC=""!POUT S NIC="" F S NIC=$O(^TMP("PRSE",$J,"L",PRSELOC,NIC)) Q:NIC=""!POUT S NSORT=$G(^TMP("PRSE",$J,"L",PRSELOC,NIC)),HOLD=1 D:NSORT
.S N1="" F S N1=$O(^TMP("PRSE",$J,"L1",NSORT,N1)) Q:N1=""!POUT S PRSETL="" F S PRSETL=$O(^TMP("PRSE",$J,"L1",NSORT,N1,PRSETL)) Q:PRSETL=""!POUT D
..S NCD="" F S NCD=$O(^TMP("PRSE",$J,"L1",NSORT,N1,PRSETL,NCD)) Q:NCD=""!POUT S DA=$O(^TMP("PRSE",$J,"L1",NSORT,N1,PRSETL,NCD,0)) Q:DA'>0 D
...I '(NSW1>0)!($Y>(IOSL-5)) D NHDR Q:POUT
...I $G(PRHLOC)'=PRSELOC D SERV S PRHLOC=PRSELOC W !
...S PCOUNT=PCOUNT+1,PRDATA=$G(^TMP("PRSE",$J,"L1",NSORT,N1,PRSETL,NCD,DA)),PHRS=(PHRS+$P(PRDATA,U)) I $P(PRDATA,U,4)="C" S PHRS("CEU")=(PHRS("CEU")+$P(PRDATA,U,2)),PHRS("CON")=(PHRS("CON")+$P(PRDATA,U,3))
...I HOLD=1 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: ",$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) W !
...Q
.S HOLD=1 Q
G QUIT:$G(POUT)
W !,$$REPEAT^XLFSTR("-",$G(IOM))
W !,?1,"Total Classes: ",PCOUNT,?$S(PRSE132:78,1:35),"Total Length/Hours:",$J(PHRS,7,2) I PRSESEL="C"!(PRSESEL="A") W !,?4,"Total CEUs:",$J(PHRS("CEU"),6,2),?$S(PRSE132:77,1:34),"Total Contact Hours:",$J(PHRS("CON"),7,2),!
QUIT ;
Q K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
Q
NHDR I 'NQ,NSW1,$E(IOST,1,2)="C-" W ! D ENDPG^PRSEUTL Q:POUT
S NPC=NPC+1
W:$E(IOST,1,2)="C-"!(NPC>1) @IOF W !,"INDIVIDUAL "
W $S(PRSESEL="C":"C.E.",PRSESEL="M":"M.I.",PRSESEL="O":"OTHER",PRSESEL="W":"WARD",1:"COMPLETE")_" TRAINING REPORT FOR "_$S(TYP="C":"CY ",TYP="F":"FY ",1:" ")_$S(TYP="C"!(TYP="F"):$G(PYR),1:$G(YRST(1))_" - "_$G(YREND(1)))
S X="T" D ^%DT D:+Y D^DIQ
I PRSE132 D
.W ?101,Y,?121,"PAGE: ",NPC
.W !,"Class Name",?55,"Class Presenter",?114,"Date"
E D
.W ?55,Y,?71,"PAGE: ",NPC
.W !,"Class Name",?30,"Class Presenter",?67,"Date"
S NI="",$P(NI,"-",$S(PRSE132:133,1:81))="" W !,NI Q:$O(^TMP("PRSE",$J,"L",""))=""
S (HOLD,NSW1)=1
W !
Q
L F X="PHRS*","PCOUNT","PSPC","PSP","PYR","PRDA","HOLD","PRSECLS","PRSESEL","PRSESER","NSW2","POUT","REQWRD","NQ","NSP*","NSPC*","NPC","POUT","NSW1","NSP","NSPC","PRSECORD","TYP" S ZTSAVE(X)=""
Q
SORT ;
W:$E(IOST,1,2)="C-"&('$R(100)) "."
S N1=$S($D(^VA(200,PRDA,0))&($P(^(0),"^")'=""):$P(^(0),"^"),1:" BLANK")
S PRSETL="",SSN=$P($G(^VA(200,+PRDA,1)),U,9) Q:SSN="" S PRDA(1)=+$O(^PRSPC("SSN",SSN,0)) S PRCOD=$S($P($G(^PRSPC(PRDA(1),0)),U,17)'="":$P($G(^(0)),U,17),1:0),PRSETL=$$EN12^PRSEUTL2($G(PRCOD)) S:PRSETL="" PRSETL=" BLANK"
S PRSE="" F S PRSE=$O(^PRSE(452,"AA",PRSE)) Q:PRSE="" S NIC1="" F S NIC1=$O(^PRSE(452,"AA",PRSE,PRDA,NIC1)) Q:NIC1="" D
.I $S('(PRSESEL="A")&($D(^PRSE(452,"AA",PRSESEL,PRDA,NIC1))):0,PRSESEL="A":0,1:1) Q
.F NCD1=0:0 S NCD1=$O(^PRSE(452,"AA",PRSE,PRDA,NIC1,NCD1)) Q:NCD1'>0 S NCD=(9999999.0000-NCD1) F DA(2)=0:0 S DA(2)=$O(^PRSE(452,"AA",PRSE,PRDA,NIC1,NCD1,DA(2))) Q:DA(2)'>0 D
..S:$G(NSORT)="" NSORT=1
..I $D(NSPC)#2,'(NSPC=NIC1) Q
..I (NCD>YREND)!(NCD<YRST) Q
..N X S PRDATA=$G(^PRSE(452,DA(2),0)),PRSELOC=$S($P(PRDATA,U,13)'="":$P(PRDATA,U,13),1:" BLANK"),X=$G(^TMP("PRSE",$J,"L",PRSELOC,NIC1))
..I X="" S X=NSORT,NSORT=NSORT+1,^TMP("PRSE",$J,"L",PRSELOC,NIC1)=X
..S PRSECLS(0)=+$O(^PRSE(452.1,"B",NIC1,0))
..S ^TMP("PRSE",$J,"L1",X,N1,PRSETL,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)
..Q
.Q
Q
;
SERV W !
I $G(PRHLOC)'=$G(PRSELOC) W "Sponsoring",!?2,"Service: "_$S(PRSELOC=" BLANK":"<Unknown>",1:$S(PRSE132:PRSELOC,1:$E(PRSELOC,1,16)))
W ?$S(PRSE132:46,1:28),"Name: ",$S(PRSE132:N1,1:$E(N1,1,20)),?$S(PRSE132:92,1:52),"Title: ",$S(PRSETL=" BLANK":"<Unknown>",+PRSETL=PRSETL:"<Unknown>",1:$S(PRSE132:$E(PRSETL,1,40),1:$E(PRSETL,1,20)))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEEMP1 5168 printed Nov 22, 2024@17:36:39 Page 2
PRSEEMP1 ;HISC/JH-INDIVIDUAL INSERVICE ATTENDANCE REPORT ;9/17/1998
+1 ;;4.0;PAID;**20,44**;Sep 21, 1995
EN1 ; INDIVIDUAL STUDENT TRAINING REPORT
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 SET (POUT,NPC,NQ,NSW1)=0
SET HOLD=1
DO EN2^PRSEUTL3($GET(DUZ))
IF '(PRSESER>0)
DO MSG3^PRSEMSG
GOTO QUIT
+3 WRITE !
SET DATSEL="N+"
DO DATSEL^PRSEUTL
if $GET(POUT)
GOTO QUIT
DO INS^PRSEUTL
if $GET(POUT)
GOTO QUIT
+4 if '(PRSESEL="A")
DO EN5^PRSEUTL2
if $GET(POUT)
GOTO Q
+5 SET DIC("S")="I +$$EN4^PRSEUTL3($G(DUZ))!(+$$EN6^PRSEUTL3($G(DUZ))&(+$$EN3^PRSEUTL3(+$G(Y))=PRSESER))!(DUZ(0)[""@"")"
+6 IF +$$EN4^PRSEUTL3($GET(DUZ))!(+$$EN6^PRSEUTL3($GET(DUZ)))!(DUZ(0)["@")
WRITE !
DO EN6^PRSEUTL2
if $GET(POUT)!'(+Y>0)
GOTO QUIT
SET PRDA=+Y
+7 if $GET(PRDA)'>0
SET PRDA=DUZ
+8 WRITE !
SET ZTRTN="START^PRSEEMP1"
SET ZTDESC="INDIVIDUAL EMPLOYEE TRAINING REPORT"
DO L
DO DEV^PRSEUTL
if POP!($DATA(ZTSK))
GOTO QUIT
START ;
+1 SET (PHRS,PHRS("CEU"),PHRS("CON"),PCOUNT)=0
SET PRSE132=$SELECT(IOM'<132:132,1:0)
DO SORT
USE IO
+2 NEW PRHLOC
+3 SET X=$ORDER(^TMP("PRSE",$JOB,"L",""))
IF X=""
DO NHDR
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
WRITE !,"EMPLOYEE: ",$PIECE($GET(^VA(200,PRDA,0)),U)
if $GET(PRSECLS)]""
WRITE !,"CLASS: ",PRSECLS
WRITE !
GOTO QUIT
+4 SET PRSELOC=""
FOR
SET PRSELOC=$ORDER(^TMP("PRSE",$JOB,"L",PRSELOC))
if PRSELOC=""!POUT
QUIT
SET NIC=""
FOR
SET NIC=$ORDER(^TMP("PRSE",$JOB,"L",PRSELOC,NIC))
if NIC=""!POUT
QUIT
SET NSORT=$GET(^TMP("PRSE",$JOB,"L",PRSELOC,NIC))
SET HOLD=1
if NSORT
Begin DoDot:1
+5 SET N1=""
FOR
SET N1=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,N1))
if N1=""!POUT
QUIT
SET PRSETL=""
FOR
SET PRSETL=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,N1,PRSETL))
if PRSETL=""!POUT
QUIT
Begin DoDot:2
+6 SET NCD=""
FOR
SET NCD=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,N1,PRSETL,NCD))
if NCD=""!POUT
QUIT
SET DA=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,N1,PRSETL,NCD,0))
if DA'>0
QUIT
Begin DoDot:3
+7 IF '(NSW1>0)!($Y>(IOSL-5))
DO NHDR
if POUT
QUIT
+8 IF $GET(PRHLOC)'=PRSELOC
DO SERV
SET PRHLOC=PRSELOC
WRITE !
+9 SET PCOUNT=PCOUNT+1
SET PRDATA=$GET(^TMP("PRSE",$JOB,"L1",NSORT,N1,PRSETL,NCD,DA))
SET PHRS=(PHRS+$PIECE(PRDATA,U))
IF $PIECE(PRDATA,U,4)="C"
SET PHRS("CEU")=(PHRS("CEU")+$PIECE(PRDATA,U,2))
SET PHRS("CON")=(PHRS("CON")+$PIECE(PRDATA,U,3))
+10 IF HOLD=1
WRITE !,$SELECT(PRSE132:NIC,1:$EXTRACT(NIC,1,25))
if $PIECE($GET(^PRSE(452,DA,6)),U,2)'=""
WRITE ?$SELECT(PRSE132:55,1:27),$EXTRACT($PIECE(^(6),U,2),1,25)
WRITE ?$SELECT(PRSE132:93,1:47),"Length: ",$SELECT($PIECE(PRDATA,U)>0:$JUSTIFY($PIECE(PRDATA,U),4,2),1:"")
SET HOLD=0
+11 SET Y=$EXTRACT(NCD,1,7)
if +Y
DO D^DIQ
WRITE ?$SELECT(PRSE132:114,1:67),$PIECE(Y,"@"),!
+12 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)
WRITE !
+13 QUIT
End DoDot:3
End DoDot:2
+14 SET HOLD=1
QUIT
End DoDot:1
+15 if $GET(POUT)
GOTO QUIT
+16 WRITE !,$$REPEAT^XLFSTR("-",$GET(IOM))
+17 WRITE !,?1,"Total Classes: ",PCOUNT,?$SELECT(PRSE132:78,1:35),"Total Length/Hours:",$JUSTIFY(PHRS,7,2)
IF PRSESEL="C"!(PRSESEL="A")
WRITE !,?4,"Total CEUs:",$JUSTIFY(PHRS("CEU"),6,2),?$SELECT(PRSE132:77,1:34),"Total Contact Hours:",$JUSTIFY(PHRS("CON"),7,2),!
QUIT ;
Q KILL ^TMP("PRSE",$JOB)
DO CLOSE^PRSEUTL
DO ^PRSEKILL
+1 QUIT
NHDR IF 'NQ
IF NSW1
IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO ENDPG^PRSEUTL
if POUT
QUIT
+1 SET NPC=NPC+1
+2 if $EXTRACT(IOST,1,2)="C-"!(NPC>1)
WRITE @IOF
WRITE !,"INDIVIDUAL "
+3 WRITE $SELECT(PRSESEL="C":"C.E.",PRSESEL="M":"M.I.",PRSESEL="O":"OTHER",PRSESEL="W":"WARD",1:"COMPLETE")_" TRAINING REPORT FOR "_$SELECT(TYP="C":"CY ",TYP="F":"FY ",1:" ")_$SELECT(TYP="C"!(TYP="F"):$GET(PYR),1:$GET(YRST(1))_" - "_$GET(YREND(1))
)
+4 SET X="T"
DO ^%DT
if +Y
DO D^DIQ
+5 IF PRSE132
Begin DoDot:1
+6 WRITE ?101,Y,?121,"PAGE: ",NPC
+7 WRITE !,"Class Name",?55,"Class Presenter",?114,"Date"
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE ?55,Y,?71,"PAGE: ",NPC
+10 WRITE !,"Class Name",?30,"Class Presenter",?67,"Date"
End DoDot:1
+11 SET NI=""
SET $PIECE(NI,"-",$SELECT(PRSE132:133,1:81))=""
WRITE !,NI
if $ORDER(^TMP("PRSE",$JOB,"L",""))=""
QUIT
+12 SET (HOLD,NSW1)=1
+13 WRITE !
+14 QUIT
L FOR X="PHRS*","PCOUNT","PSPC","PSP","PYR","PRDA","HOLD","PRSECLS","PRSESEL","PRSESER","NSW2","POUT","REQWRD","NQ","NSP*","NSPC*","NPC","POUT","NSW1","NSP","NSPC","PRSECORD","TYP"
SET ZTSAVE(X)=""
+1 QUIT
SORT ;
+1 if $EXTRACT(IOST,1,2)="C-"&('$RANDOM(100))
WRITE "."
+2 SET N1=$SELECT($DATA(^VA(200,PRDA,0))&($PIECE(^(0),"^")'=""):$PIECE(^(0),"^"),1:" BLANK")
+3 SET PRSETL=""
SET SSN=$PIECE($GET(^VA(200,+PRDA,1)),U,9)
if SSN=""
QUIT
SET PRDA(1)=+$ORDER(^PRSPC("SSN",SSN,0))
SET PRCOD=$SELECT($PIECE($GET(^PRSPC(PRDA(1),0)),U,17)'="":$PIECE($GET(^(0)),U,17),1:0)
SET PRSETL=$$EN12^PRSEUTL2($GET(PRCOD))
if PRSETL=""
SET PRSETL=" BLANK"
+4 SET PRSE=""
FOR
SET PRSE=$ORDER(^PRSE(452,"AA",PRSE))
if PRSE=""
QUIT
SET NIC1=""
FOR
SET NIC1=$ORDER(^PRSE(452,"AA",PRSE,PRDA,NIC1))
if NIC1=""
QUIT
Begin DoDot:1
+5 IF $SELECT('(PRSESEL="A")&($DATA(^PRSE(452,"AA",PRSESEL,PRDA,NIC1))):0,PRSESEL="A":0,1:1)
QUIT
+6 FOR NCD1=0:0
SET NCD1=$ORDER(^PRSE(452,"AA",PRSE,PRDA,NIC1,NCD1))
if NCD1'>0
QUIT
SET NCD=(9999999.0000-NCD1)
FOR DA(2)=0:0
SET DA(2)=$ORDER(^PRSE(452,"AA",PRSE,PRDA,NIC1,NCD1,DA(2)))
if DA(2)'>0
QUIT
Begin DoDot:2
+7 if $GET(NSORT)=""
SET NSORT=1
+8 IF $DATA(NSPC)#2
IF '(NSPC=NIC1)
QUIT
+9 IF (NCD>YREND)!(NCD<YRST)
QUIT
+10 NEW X
SET PRDATA=$GET(^PRSE(452,DA(2),0))
SET PRSELOC=$SELECT($PIECE(PRDATA,U,13)'="":$PIECE(PRDATA,U,13),1:" BLANK")
SET X=$GET(^TMP("PRSE",$JOB,"L",PRSELOC,NIC1))
+11 IF X=""
SET X=NSORT
SET NSORT=NSORT+1
SET ^TMP("PRSE",$JOB,"L",PRSELOC,NIC1)=X
+12 SET PRSECLS(0)=+$ORDER(^PRSE(452.1,"B",NIC1,0))
+13 SET ^TMP("PRSE",$JOB,"L1",X,N1,PRSETL,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)
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
SERV WRITE !
+1 IF $GET(PRHLOC)'=$GET(PRSELOC)
WRITE "Sponsoring",!?2,"Service: "_$SELECT(PRSELOC=" BLANK":"<Unknown>",1:$SELECT(PRSE132:PRSELOC,1:$EXTRACT(PRSELOC,1,16)))
+2 WRITE ?$SELECT(PRSE132:46,1:28),"Name: ",$SELECT(PRSE132:N1,1:$EXTRACT(N1,1,20)),?$SELECT(PRSE132:92,1:52),"Title: ",$SELECT(PRSETL=" BLANK":"<Unknown>",+PRSETL=PRSETL:"<Unknown>",1:$SELECT(PRSE132:$EXTRACT(PRSETL,1,40),1:$EXTRACT(PRSETL,1,20)
))
+3 QUIT
