source: FOIAVistA/tag/r/PAID-PRS/PRSEEMP3.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1PRSEEMP3 ;WIRMFO/JAH-STUDENT TRAINING REPORT BY SERVICE ;7/2/97
2 ;;4.0;PAID;**25**;Sep 21, 1995
3 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
4EN1 ;
5 N PRSE132,CCORG,PRSERV,ZZ,SERVIEN,CLOCK,HWIDE,X,DATSEL,POUT
6 N CEU,PRESEL,SERCNT,EMPCNT,CCOCNT,YRST,YREND,REPDT
7 ;set spin clock counter
8 S CLOCK=1
9 ;
10 ;If user has PRSE CORD key/programmer continue
11 I '(+$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)["@")) D MSG22^PRSEMSG S ZZ=$$ASK^PRSLIB00(1) Q
12 ;
13 ;Check 2 make sure Educ. Track. is Online
14 S X=$G(^PRSE(452.7,1,"OFF"))
15 I X=""!(X=1) D MSG6^PRSEMSG S ZZ=$$ASK^PRSLIB00(1) Q
16 ;
17 S (POUT,NPC,NSW1)=0,HOLD=1
18 ;
19 ;Ask date range/fiscal/calender year. YRST, YREND returned as range.
20 W ! S DATSEL="N+"
21 D DATSEL^PRSEUTL G:$G(POUT) EXIT^PRSEEMP4
22 ;
23 ;Ask type of training 2 search. Code 4 search returned in PRSESEL.
24 ;M:Mandatory C:Continuing Educ O:Other W:Ward/Unit-Locat
25 ;A:All ;L:All without Mandatory
26 D INS2^PRSEUTL G EXIT^PRSEEMP4:$G(POUT)
27 ;
28 ;set flag when selection contains CEU type classes.
29 S CEU=0
30 I PRSESEL="C"!(PRSESEL="A")!(PRSESEL="L")!(PRSESEL="H") S CEU=1
31 ;
32 ; find hospital wide classes 2 screen out of report
33 I PRSESEL="H" D HWLIST^PRSEEMP4,HASHLIST^PRSEEMP4
34 ;
35 ;call 2 select 1,many,all services.
36 N DIC,Y
37 S DIC="^PRSP(454.1,"
38 S VAUTSTR="Service"
39 S VAUTNI=2,VAUTVB="PRSERV"
40 D FIRST^VAUTOMA
41 ;
42 ;quit if user ^ at service prompt
43 Q:Y<0
44 ;
45 W ! S ZTRTN="START^PRSEEMP3",ZTDESC="TRAINING REPORT BY SERVICE" D L,DEV^PRSEUTL G:POP!($D(ZTSK)) EXIT^PRSEEMP4
46START ;
47 U IO
48 ;initialize temp global and set unknown entry in job table.
49 K ^TMP($J),^TMP("JOBS",$J)
50 S ^TMP("JOBS",$J,0)="unknown"
51 ;
52 I $E(IOST,1,2)="C-" D
53 . D MSSG^PRSLIB00(.MSG)
54 . D MONOGRPH^PRSLIB00(MSG)
55 S (PHRS,PHRS("CEU"),PHRS("CON"),PCOUNT)=0,PRSE132=$S(IOM'<132:132,1:0)
56 ;
57 ;If user selects all services then fill up PRSERV array
58 I PRSERV=1 D ALLSERV(.PRSERV)
59 ;
60 ;Drive thru services user has selected. They may select 1,many,all
61 ;or abort. If user selects 1 or 1+, PRSERV(ien)=selection(s),
62 ;PRSERV=0. If user selects ALL, PRSERV=1
63 N SERVICE,SERVIEN,EMPIEN,EMPNAME,CCIEN,CCORG
64 S (SERVIEN,POUT,SRVCNT)=0
65 F S SERVIEN=$O(PRSERV(SERVIEN)) Q:SERVIEN=""!(POUT) D
66 . S SRVCNT=SRVCNT+1
67 . S SERVICE=PRSERV(SERVIEN)
68 .;
69 .;There r many Cost Ctrs 4 each service. Use cost ctrs
70 .;2 find all employees in service.
71 . S CCIEN=0
72 . F S CCIEN=$O(^PRSP(454,1,"ORG","C",SERVIEN,CCIEN)) Q:CCIEN=""!(POUT) D
73 .. S CCORG=$P(^PRSP(454,1,"ORG",CCIEN,0),"^",1)
74 .. S CCORG=$P(CCORG,":",1)_$P(CCORG,":",2)
75 ..;
76 ..; Get employees w/in cost ctr
77 .. S EMPIEN=0
78 .. F S EMPIEN=$O(^PRSPC("ACC",CCORG,EMPIEN)) Q:EMPIEN=""!(POUT) D
79 ... S EMPNAME=$P($G(^PRSPC(EMPIEN,0)),"^",1)
80 ... S EMPOINT=$G(^PRSPC(EMPIEN,200))
81 ... I EMPOINT'="" D SORT^PRSEEMP4(EMPOINT)
82 ;
83 S (SERCNT,EMPCNT,CCOCNT)=0
84 ;get date for report
85 S X="T" D ^%DT S REPDT=+Y
86 ;Drive thru services & cost ctr/orgs 2 print output 4 employees
87 S SERVIEN=0
88 F S SERVIEN=$O(^TMP($J,SERVIEN)) Q:SERVIEN'>0!(POUT) D
89 . S SERVICE=PRSERV(SERVIEN)
90 . S SERCNT=SERCNT+1
91 .;Initialize cost ctr global & counters
92 . D INITCC(.CCORG)
93 . F S CCORG=$O(^TMP($J,SERVIEN,CCORG)) Q:CCORG=""!(POUT) D
94 .. S CCOCNT=CCOCNT+1
95 .. S EMPIEN=""
96 .. F S EMPIEN=$O(^TMP($J,SERVIEN,CCORG,EMPIEN)) Q:EMPIEN=""!(POUT) D
97 ... D INITEMP^PRSEEMP3 ;initialize course counters 4 employee
98 ... S EMPCNT=EMPCNT+1
99 ... S EMPNODE=^TMP($J,SERVIEN,CCORG,EMPIEN,0)
100 ... S DATA=$P(EMPNODE,"^",1)
101 ... S JOBCODE=$P(EMPNODE,"^",2)
102 ... S EMPNAME=$P(EMPNODE,"^",3)
103 ... D OUTPUT^PRSEEMP4(EMPIEN,.POUT,JOBCODE,EMPNAME)
104 I POUT S ^TMP("EORM",$J,2)="- Incomplete report. User aborted."
105 D STATS,MSSGS
106 D EXIT^PRSEEMP4
107 Q
108 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
109STATS ;
110 N HDR,UND,TAB1,PTAB
111 S HDR="END OF TRAINING REPORT BY SERVICE"
112 S UND="================================="
113 S PTAB=(IOM-9)
114 S TAB1=($G(IOM)/2-($L(HDR)/2)) ;center hdr on page
115 W @IOF,?PTAB,"PAGE ",NPC+1
116 W !,?TAB1,HDR,!,?TAB1,UND
117 W !,"Employees counted: ",EMPCNT
118 W !,"Services counted: ",SERCNT
119 W !,"Cost Centers counted: ",CCOCNT
120 Q
121 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
122MSSGS ;Write any messages that we've created during processing.
123 N EOR
124 W !,"----------------",!
125 ;
126 S EOR="" F S EOR=$O(^TMP("EORM",$J,EOR)) Q:EOR="" D
127 .W !,^TMP("EORM",$J,EOR)
128 W !
129 Q
130 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
131ALLSERV(PRSERV) ; Put all services in PAID COST CTR/ORGANIZATION file
132 ;in2 PRSERV() array, subscripted by IEN = "service name".
133 S SERVICE=""
134 F S SERVICE=$O(^PRSP(454.1,"B",SERVICE)) Q:SERVICE="" D
135 .S SERVIEN=0,SERVIEN=$O(^PRSP(454.1,"B",SERVICE,SERVIEN))
136 .I SERVIEN'="",$G(^PRSP(454.1,SERVIEN,0))'="" S PRSERV(SERVIEN)=SERVICE
137 Q
138 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
139INITCC(CCORG) ;INITIALIZE COST CTR STUFF
140 K ^TMP($J,"CC")
141 S CCORG=""
142 Q
143 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
144INITEMP ;initialize all counters 4 an employee
145 S (PCOUNT,PHRS,PHRS("CEU"),PHRS("CON"))=0
146 Q
147 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
148L F X="PHRS*","PCOUNT","PYR","PRDA","YRST","YREND","HOLD","PRSECLS","PRSESEL","POUT","NPC","NSW1","TYP","PRSERV*","PRSERV(","CEU" S ZTSAVE(X)=""
149 Q
150 ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Note: See TracBrowser for help on using the repository browser.