PRSEEMP ;HISC/JH-ATTENDANCE RPT BY SERVICE ;9/17/1998
;;4.0;PAID;**44**;Sep 21, 1995
EN1 ;TRAINING REPORT
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
S (NQ,POUT,NSW1,NPC)=0,HOLD=1 D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)["@") D MSG3^PRSEMSG G Q
K POUT W ! S DATSEL="N+" D DATSEL^PRSEUTL G Q:$D(POUT) D INS^PRSEUTL G Q:$D(POUT)
S DIC("S")="I +$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)[""@"")"
I '+$$EN4^PRSEUTL3($G(DUZ)),'(DUZ(0)["@") S PSPC=PRSESER("TX") G AR
D EN3^PRSEUTL1 G Q:$D(POUT)
AR I PRSESEL'="A" D EN5^PRSEUTL2 G Q:$D(POUT)
W ! S ZTRTN="START^PRSEEMP" D L^PRSEEMP2,DEV^PRSEUTL G:POP!($D(ZTSK)) Q
START ;
K ^TMP("PRSE",$J)
S (POUT,SHRS,SHRS("CEU"),SHRS("CON"),PHRS,PHRS("CEU"),PHRS("CON"),RHRS,RHRS("CEU"),RHRS("CON"),RCNT,SCNT,PCNT)=0,PRSE132=$S(IOM'<132:1,1:0)
S PRDA=DUZ I '+$$EN3^PRSEUTL3($G(PRDA)),DUZ(0)'="@",'+$$EN4^PRSEUTL3($G(DUZ)) S PSPC=PRSESER("TX"),PSP=0
F DAT=(YRST-.0000001):0 S DAT=$O(^PRSE(452,"H",DAT)) Q:DAT>YREND!(DAT="") F DA=0:0 S DA=$O(^PRSE(452,"H",DAT,DA)) Q:DA'>0 I $D(^PRSE(452,DA,0)) W:$E(IOST,1,2)="C-"&('$R(200)) "." D SORT^PRSEEMP2
I '$D(^TMP("PRSE",$J,"L")) D NHDR W !,"THERE IS NO DATA FOR THIS REPORT" W:$G(PSPC)]"" !,"SERVICE: ",PSPC W:$G(PRSECLS)]"" !,"CLASS: ",PRSECLS G Q
S PRSELOC="" F S PRSELOC=$O(^TMP("PRSE",$J,"L",PRSELOC)) Q:PRSELOC=""!POUT S HOLD=1 D Q:POUT D BRK
.S NIC="" F S NIC=$O(^TMP("PRSE",$J,"L",PRSELOC,NIC)) Q:NIC=""!POUT S NSORT=$G(^TMP("PRSE",$J,"L",PRSELOC,NIC)) S HOLD(1)=1 D Q:POUT D BRK1
..S PRSETL="" F S PRSETL=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETL)) Q:PRSETL=""!POUT S HOLD(2)=1 D Q:POUT
...S N1="" F S N1=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETL,N1)) Q:N1=""!POUT D Q:POUT
....S NCD="" F S NCD=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETL,N1,NCD)) Q:NCD=""!POUT S DA=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETL,N1,NCD,0)) Q:DA'>0 D Q:POUT
.....I NSW1'>0!($Y>(IOSL-1))!(HOLD=1) D NHDR Q:POUT
.....S PCNT=(PCNT+1),PRDATA=$G(^TMP("PRSE",$J,"L1",NSORT,PRSETL,N1,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 "Service: "_$S(PRSELOC=" BLNK":"",1:PRSELOC),! S HOLD=0
.....I HOLD(1)=1 W !,$S(PRSE132:NIC,1:$E(NIC,1,25)) W:$P($G(^PRSE(452,DA,6)),U,2)'="" ?$S(PRSE132:55,1:30),$E($P(^(6),U,2),1,29) W ?$S(PRSE132:90,1:54),"Length: ",$S($P(PRDATA,U)>0:$J($P(PRDATA,U),4,2),1:"") S HOLD(1)=0
.....W !,?5,$S(N1=" BLNK":"",1:$S(PRSE132:N1,1:$E(N1,1,20)))
.....I HOLD(2)=1 W ?$S(PRSE132:60,1:35),$S(PRSETL=" BLNK":"",1:$S(PRSE132:PRSETL,1:$E(PRSETL,1,29))) S HOLD(2)=0
.....S Y=$E(NCD,1,7) D:+Y D^DIQ W ?$S(PRSE132:106,1:67),$P(Y,"@"),!
.....I $P(PRDATA,U,4)="C" W ?5,"CEUs: ",+$P(PRDATA,U,2),?$S(PRSE132:88,1:49),"Contact HRS: ",$J($P(PRDATA,U,3),4,2),!
.....Q
....Q
...Q
..S HOLD(2)=1 Q
.S HOLD(1)=1 Q
S HOLD=1
G:$G(PSPC)'="" Q W !!,?2,"Report Classes: ",RCNT,?$S(PRSE132:96,1:41),"Report Length Hours: ",$J(RHRS,4,2),! S (RHRS,RCNT)=0
I PRSESEL="C"!(PRSESEL="A") W ?5,"Report CEUs: ",$J(RHRS("CEU"),4,2),?$S(PRSE132:95,1:40),"Report Contact Hours: ",$J(RHRS("CON"),4,2)
Q ;
K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
Q
BRK1 ;
I ($Y>(IOSL-1)),$E(IOST,1,2)="C-",HOLD=0 Q:POUT
W ?3,"Total Attendees: ",PCNT,?$S(PRSE132:95,1:42),"Total Length Hours: ",$J(PHRS,4,2),!
I PRSESEL="C"!(PRSESEL="A") W:+PHRS("CEU")>0 ?6,"Total CEUs: ",$J(PHRS("CEU"),4,2) W:+PHRS("CON")>0 ?$S(PRSE132:94,1:41),"Total Contact Hours: ",$J(PHRS("CON"),4,2),!
S SCNT=(SCNT+PCNT),SHRS=(SHRS+PHRS),(PCNT,PHRS)=0 I PRSESEL="C"!(PRSESEL="A") S SHRS("CEU")=(SHRS("CEU")+PHRS("CEU")),SHRS("CON")=(SHRS("CON")+PHRS("CON")),(PHRS("CEU"),PHRS("CON"))=0
Q
BRK ;
W !,?1,"Service Attendees: ",SCNT,?$S(PRSE132:95,1:40),"Service Length Hours: ",$J(SHRS,4,2),! S RHRS=(RHRS+SHRS),RCNT=(RCNT+SCNT),(SHRS,SCNT)=0
I PRSESEL="C"!(PRSESEL="A") W ?4,"Service CEUs: ",$J(SHRS("CEU"),4,2),?$S(PRSE132:94,1:39),"Service Contact Hours: ",$J(SHRS("CON"),4,2) S RHRS("CEU")=(RHRS("CEU")+SHRS("CEU")),RHRS("CON")=(RHRS("CON")+SHRS("CON")),(SHRS("CEU"),SHRS("CON"))=0
I ($Y>(IOSL-1)),$E(IOST,1,2)="C-",HOLD=0 Q:POUT
Q
NHDR I 'NQ,NSW1,$E(IOST,1,2)="C-" D ENDPG^PRSEUTL Q:POUT
S NPC=NPC+1
W:$E(IOST,1,2)="C-"!(NPC>1) @IOF
W !,$S(PRSESEL="C":"C.E.",PRSESEL="M":"M.I.",PRSESEL="O":"OTHER",PRSESEL="W":"WARD",1:"COMPLETE")_" SERVICE 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"
.W !,?5,"Student Name",?60,"Title",?114,"Date"
E D
.W ?55,Y,?71,"PAGE: ",NPC
.W !,"Class Name",?30,"Class Presenter"
.W !,?5,"Student Name",?35,"Title",?67,"Date"
S NI="",$P(NI,"-",$S(PRSE132:133,1:81))="" W !,NI
S (HOLD,HOLD(1),HOLD(2),NSW1)=1
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEEMP 4861 printed Dec 13, 2024@02:26:35 Page 2
PRSEEMP ;HISC/JH-ATTENDANCE RPT BY SERVICE ;9/17/1998
+1 ;;4.0;PAID;**44**;Sep 21, 1995
EN1 ;TRAINING REPORT
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 SET (NQ,POUT,NSW1,NPC)=0
SET HOLD=1
DO EN2^PRSEUTL3($GET(DUZ))
IF PRSESER=""&'(DUZ(0)["@")
DO MSG3^PRSEMSG
GOTO Q
+3 KILL POUT
WRITE !
SET DATSEL="N+"
DO DATSEL^PRSEUTL
if $DATA(POUT)
GOTO Q
DO INS^PRSEUTL
if $DATA(POUT)
GOTO Q
+4 SET DIC("S")="I +$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)[""@"")"
+5 IF '+$$EN4^PRSEUTL3($GET(DUZ))
IF '(DUZ(0)["@")
SET PSPC=PRSESER("TX")
GOTO AR
+6 DO EN3^PRSEUTL1
if $DATA(POUT)
GOTO Q
AR IF PRSESEL'="A"
DO EN5^PRSEUTL2
if $DATA(POUT)
GOTO Q
+1 WRITE !
SET ZTRTN="START^PRSEEMP"
DO L^PRSEEMP2
DO DEV^PRSEUTL
if POP!($DATA(ZTSK))
GOTO Q
START ;
+1 KILL ^TMP("PRSE",$JOB)
+2 SET (POUT,SHRS,SHRS("CEU"),SHRS("CON"),PHRS,PHRS("CEU"),PHRS("CON"),RHRS,RHRS("CEU"),RHRS("CON"),RCNT,SCNT,PCNT)=0
SET PRSE132=$SELECT(IOM'<132:1,1:0)
+3 SET PRDA=DUZ
IF '+$$EN3^PRSEUTL3($GET(PRDA))
IF DUZ(0)'="@"
IF '+$$EN4^PRSEUTL3($GET(DUZ))
SET PSPC=PRSESER("TX")
SET PSP=0
+4 FOR DAT=(YRST-.0000001):0
SET DAT=$ORDER(^PRSE(452,"H",DAT))
if DAT>YREND!(DAT="")
QUIT
FOR DA=0:0
SET DA=$ORDER(^PRSE(452,"H",DAT,DA))
if DA'>0
QUIT
IF $DATA(^PRSE(452,DA,0))
if $EXTRACT(IOST,1,2)="C-"&('$RANDOM(200))
WRITE "."
DO SORT^PRSEEMP2
+5 IF '$DATA(^TMP("PRSE",$JOB,"L"))
DO NHDR
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
if $GET(PSPC)]""
WRITE !,"SERVICE: ",PSPC
if $GET(PRSECLS)]""
WRITE !,"CLASS: ",PRSECLS
GOTO Q
+6 SET PRSELOC=""
FOR
SET PRSELOC=$ORDER(^TMP("PRSE",$JOB,"L",PRSELOC))
if PRSELOC=""!POUT
QUIT
SET HOLD=1
Begin DoDot:1
+7 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)=1
Begin DoDot:2
+8 SET PRSETL=""
FOR
SET PRSETL=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,PRSETL))
if PRSETL=""!POUT
QUIT
SET HOLD(2)=1
Begin DoDot:3
+9 SET N1=""
FOR
SET N1=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,PRSETL,N1))
if N1=""!POUT
QUIT
Begin DoDot:4
+10 SET NCD=""
FOR
SET NCD=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,PRSETL,N1,NCD))
if NCD=""!POUT
QUIT
SET DA=$ORDER(^TMP("PRSE",$JOB,"L1",NSORT,PRSETL,N1,NCD,0))
if DA'>0
QUIT
Begin DoDot:5
+11 IF NSW1'>0!($Y>(IOSL-1))!(HOLD=1)
DO NHDR
if POUT
QUIT
+12 SET PCNT=(PCNT+1)
SET PRDATA=$GET(^TMP("PRSE",$JOB,"L1",NSORT,PRSETL,N1,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))
+13 IF HOLD=1
WRITE "Service: "_$SELECT(PRSELOC=" BLNK":"",1:PRSELOC),!
SET HOLD=0
+14 IF HOLD(1)=1
WRITE !,$SELECT(PRSE132:NIC,1:$EXTRACT(NIC,1,25))
if $PIECE($GET(^PRSE(452,DA,6)),U,2)'=""
WRITE ?$SELECT(PRSE132:55,1:30),$EXTRACT($PIECE(^(6),U,2),1,29)
WRITE ?$SELECT(PRSE132:90,1:54),"Length: ",$SELECT($PIECE(PRDATA,U)>0:$JUSTIFY($PIECE(PRDATA,U),4,2),1:"")
SET HOLD(1)=0
+15 WRITE !,?5,$SELECT(N1=" BLNK":"",1:$SELECT(PRSE132:N1,1:$EXTRACT(N1,1,20)))
+16 IF HOLD(2)=1
WRITE ?$SELECT(PRSE132:60,1:35),$SELECT(PRSETL=" BLNK":"",1:$SELECT(PRSE132:PRSETL,1:$EXTRACT(PRSETL,1,29)))
SET HOLD(2)=0
+17 SET Y=$EXTRACT(NCD,1,7)
if +Y
DO D^DIQ
WRITE ?$SELECT(PRSE132:106,1:67),$PIECE(Y,"@"),!
+18 IF $PIECE(PRDATA,U,4)="C"
WRITE ?5,"CEUs: ",+$PIECE(PRDATA,U,2),?$SELECT(PRSE132:88,1:49),"Contact HRS: ",$JUSTIFY($PIECE(PRDATA,U,3),4,2),!
+19 QUIT
End DoDot:5
if POUT
QUIT
+20 QUIT
End DoDot:4
if POUT
QUIT
+21 QUIT
End DoDot:3
if POUT
QUIT
+22 SET HOLD(2)=1
QUIT
End DoDot:2
if POUT
QUIT
DO BRK1
+23 SET HOLD(1)=1
QUIT
End DoDot:1
if POUT
QUIT
DO BRK
+24 SET HOLD=1
+25 if $GET(PSPC)'=""
GOTO Q
WRITE !!,?2,"Report Classes: ",RCNT,?$SELECT(PRSE132:96,1:41),"Report Length Hours: ",$JUSTIFY(RHRS,4,2),!
SET (RHRS,RCNT)=0
+26 IF PRSESEL="C"!(PRSESEL="A")
WRITE ?5,"Report CEUs: ",$JUSTIFY(RHRS("CEU"),4,2),?$SELECT(PRSE132:95,1:40),"Report Contact Hours: ",$JUSTIFY(RHRS("CON"),4,2)
Q ;
+1 KILL ^TMP("PRSE",$JOB)
DO CLOSE^PRSEUTL
DO ^PRSEKILL
+2 QUIT
BRK1 ;
+1 IF ($Y>(IOSL-1))
IF $EXTRACT(IOST,1,2)="C-"
IF HOLD=0
if POUT
QUIT
+2 WRITE ?3,"Total Attendees: ",PCNT,?$SELECT(PRSE132:95,1:42),"Total Length Hours: ",$JUSTIFY(PHRS,4,2),!
+3 IF PRSESEL="C"!(PRSESEL="A")
if +PHRS("CEU")>0
WRITE ?6,"Total CEUs: ",$JUSTIFY(PHRS("CEU"),4,2)
if +PHRS("CON")>0
WRITE ?$SELECT(PRSE132:94,1:41),"Total Contact Hours: ",$JUSTIFY(PHRS("CON"),4,2),!
+4 SET SCNT=(SCNT+PCNT)
SET SHRS=(SHRS+PHRS)
SET (PCNT,PHRS)=0
IF PRSESEL="C"!(PRSESEL="A")
SET SHRS("CEU")=(SHRS("CEU")+PHRS("CEU"))
SET SHRS("CON")=(SHRS("CON")+PHRS("CON"))
SET (PHRS("CEU"),PHRS("CON"))=0
+5 QUIT
BRK ;
+1 WRITE !,?1,"Service Attendees: ",SCNT,?$SELECT(PRSE132:95,1:40),"Service Length Hours: ",$JUSTIFY(SHRS,4,2),!
SET RHRS=(RHRS+SHRS)
SET RCNT=(RCNT+SCNT)
SET (SHRS,SCNT)=0
+2 IF PRSESEL="C"!(PRSESEL="A")
WRITE ?4,"Service CEUs: ",$JUSTIFY(SHRS("CEU"),4,2),?$SELECT(PRSE132:94,1:39),"Service Contact Hours: ",$JUSTIFY(SHRS("CON"),4,2)
SET RHRS("CEU")=(RHRS("CEU")+SHRS("CEU"))
SET RHRS("CON")=(RHRS("CON")+SHRS("CON"))
SET (SHRS("CEU"),SHRS("CON"))=0
+3 IF ($Y>(IOSL-1))
IF $EXTRACT(IOST,1,2)="C-"
IF HOLD=0
if POUT
QUIT
+4 QUIT
NHDR IF 'NQ
IF NSW1
IF $EXTRACT(IOST,1,2)="C-"
DO ENDPG^PRSEUTL
if POUT
QUIT
+1 SET NPC=NPC+1
+2 if $EXTRACT(IOST,1,2)="C-"!(NPC>1)
WRITE @IOF
+3 WRITE !,$SELECT(PRSESEL="C":"C.E.",PRSESEL="M":"M.I.",PRSESEL="O":"OTHER",PRSESEL="W":"WARD",1:"COMPLETE")_" SERVICE 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"
+8 WRITE !,?5,"Student Name",?60,"Title",?114,"Date"
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE ?55,Y,?71,"PAGE: ",NPC
+11 WRITE !,"Class Name",?30,"Class Presenter"
+12 WRITE !,?5,"Student Name",?35,"Title",?67,"Date"
End DoDot:1
+13 SET NI=""
SET $PIECE(NI,"-",$SELECT(PRSE132:133,1:81))=""
WRITE !,NI
+14 SET (HOLD,HOLD(1),HOLD(2),NSW1)=1
+15 WRITE !
+16 QUIT
