source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEEMP.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1PRSEEMP ;HISC/JH-ATTENDANCE RPT BY SERVICE ;9/17/1998
2 ;;4.0;PAID;**44**;Sep 21, 1995
3EN1 ;TRAINING REPORT
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 S (NQ,POUT,NSW1,NPC)=0,HOLD=1 D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)["@") D MSG3^PRSEMSG G Q
6 K POUT W ! S DATSEL="N+" D DATSEL^PRSEUTL G Q:$D(POUT) D INS^PRSEUTL G Q:$D(POUT)
7 S DIC("S")="I +$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)[""@"")"
8 I '+$$EN4^PRSEUTL3($G(DUZ)),'(DUZ(0)["@") S PSPC=PRSESER("TX") G AR
9 D EN3^PRSEUTL1 G Q:$D(POUT)
10AR I PRSESEL'="A" D EN5^PRSEUTL2 G Q:$D(POUT)
11 W ! S ZTRTN="START^PRSEEMP" D L^PRSEEMP2,DEV^PRSEUTL G:POP!($D(ZTSK)) Q
12START ;
13 K ^TMP("PRSE",$J)
14 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)
15 S PRDA=DUZ I '+$$EN3^PRSEUTL3($G(PRDA)),DUZ(0)'="@",'+$$EN4^PRSEUTL3($G(DUZ)) S PSPC=PRSESER("TX"),PSP=0
16 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
17 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
18 S PRSELOC="" F S PRSELOC=$O(^TMP("PRSE",$J,"L",PRSELOC)) Q:PRSELOC=""!POUT S HOLD=1 D Q:POUT D BRK
19 .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
20 ..S PRSETL="" F S PRSETL=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETL)) Q:PRSETL=""!POUT S HOLD(2)=1 D Q:POUT
21 ...S N1="" F S N1=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETL,N1)) Q:N1=""!POUT D Q:POUT
22 ....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
23 .....I NSW1'>0!($Y>(IOSL-1))!(HOLD=1) D NHDR Q:POUT
24 .....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))
25 .....I HOLD=1 W "Service: "_$S(PRSELOC=" BLNK":"",1:PRSELOC),! S HOLD=0
26 .....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
27 .....W !,?5,$S(N1=" BLNK":"",1:$S(PRSE132:N1,1:$E(N1,1,20)))
28 .....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
29 .....S Y=$E(NCD,1,7) D:+Y D^DIQ W ?$S(PRSE132:106,1:67),$P(Y,"@"),!
30 .....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),!
31 .....Q
32 ....Q
33 ...Q
34 ..S HOLD(2)=1 Q
35 .S HOLD(1)=1 Q
36 S HOLD=1
37 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
38 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)
39Q ;
40 K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
41 Q
42BRK1 ;
43 I ($Y>(IOSL-1)),$E(IOST,1,2)="C-",HOLD=0 Q:POUT
44 W ?3,"Total Attendees: ",PCNT,?$S(PRSE132:95,1:42),"Total Length Hours: ",$J(PHRS,4,2),!
45 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),!
46 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
47 Q
48BRK ;
49 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
50 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
51 I ($Y>(IOSL-1)),$E(IOST,1,2)="C-",HOLD=0 Q:POUT
52 Q
53NHDR I 'NQ,NSW1,$E(IOST,1,2)="C-" D ENDPG^PRSEUTL Q:POUT
54 S NPC=NPC+1
55 W:$E(IOST,1,2)="C-"!(NPC>1) @IOF
56 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)))
57 S X="T" D ^%DT D:+Y D^DIQ
58 I PRSE132 D
59 .W ?101,Y,?121,"PAGE: ",NPC
60 .W !,"Class Name",?55,"Class Presenter"
61 .W !,?5,"Student Name",?60,"Title",?114,"Date"
62 E D
63 .W ?55,Y,?71,"PAGE: ",NPC
64 .W !,"Class Name",?30,"Class Presenter"
65 .W !,?5,"Student Name",?35,"Title",?67,"Date"
66 S NI="",$P(NI,"-",$S(PRSE132:133,1:81))="" W !,NI
67 S (HOLD,HOLD(1),HOLD(2),NSW1)=1
68 W !
69 Q
Note: See TracBrowser for help on using the repository browser.