source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEPOL1.m

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PRSEPOL1 ;HISC/DAD,MD-OLDE TRAINING CODING REPORT ;8/26/94 09:34
2 ;;4.0;PAID;**18**;Sep 21, 1995
3ENTSK ;
4 K ^TMP("PRSE",$J)
5 S PRSEDATE=YRST-.0000001
6 F S PRSEDATE=$O(^PRSE(452,"H",PRSEDATE)) Q:PRSEDATE'>0!(PRSEDATE>YREND) D
7 . S PRSED0=0
8 . F S PRSED0=$O(^PRSE(452,"H",PRSEDATE,PRSED0)) Q:PRSED0'>0 D
9 .. S PRSE=$G(^PRSE(452,PRSED0,0))
10 .. S PRSE200=+PRSE,PRSESSN=$P(PRSE,U,11) Q:PRSE200'>0!(PRSESSN="")
11 .. I PRSESEL="S",$D(PRSEXMY(+$$EN13^PRSEUTL3(PRSE200)))#2 D Q
12 ... S ^TMP("PRSE",$J,PRSESSN,PRSED0)=""
13 ... Q
14 .. I PRSESEL="A",($$EN2^PRSEUTL4(+$$EN13^PRSEUTL3(PRSE200))=PSPC("TX")!PSP) D Q
15 ... S ^TMP("PRSE",$J,PRSESSN,PRSED0)=""
16 ... Q
17 .. Q
18 . Q
19 S PRSEQUIT=0,PRSEPAGE=1,PRSEUNDL="",$P(PRSEUNDL,"-",81)=""
20 S Y=DT D DD^%DT S PRSENOW=Y
21 K PRSETXT
22 F PRSE=1:1 S PRSETXT=$P($T(DATA+PRSE),";",3) Q:PRSETXT="" D
23 . S PRSETXT(PRSE)=PRSETXT_":"
24 . Q
25 U IO D HEADER
26 S (PRSESSN,PRSEPRNT)=0
27 F S PRSESSN=$O(^TMP("PRSE",$J,PRSESSN)) Q:PRSESSN'>0!PRSEQUIT D
28 . S PRSED0=0
29 . F S PRSED0=$O(^TMP("PRSE",$J,PRSESSN,PRSED0)) Q:PRSED0'>0!PRSEQUIT D GETDATA
30 . Q
31 I PRSEPRNT'>0 W !!,"No data found for this report"
32 Q
33GETDATA ;
34 K PRSEDATA
35 S PRSE(0)=$G(^PRSE(452,PRSED0,0)),PRSE(2)=$G(^(2)),PRSE(6)=$G(^(6))
36 I $P(PRSE(0),U,12)'="Y" Q ; *** 'CODE FOR OLDE' not set to 'YES'
37 S PRSETYED=$P(PRSE(0),U,21) I "^C^M^O^"'[(U_PRSETYED_U) Q ; Type=C/M/O
38 S PRSEDATA(1)=$P(PRSE(0),U,11)
39 S PRSEDATA(1)=$E("000000000",1,9-$L(PRSEDATA(1)))_PRSEDATA(1)
40 S (Y,PRSEY)=$P(PRSE(0),U),C=$P(^DD(452,.01,0),U,2)
41 I Y]"" D Y^DIQ I Y]"" D
42 . S X=$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3(+PRSEY),0)),U)
43 . S PRSEDATA(2)=Y_" - "_$S(X]"":X,1:"UNKNOWN")
44 . Q
45 S (PRSEDATA,Y)=$P(PRSE(0),U,22),C=$P(^DD(452,15,0),U,2)
46 I Y]"" D Y^DIQ I Y]"" S PRSEDATA(3)=PRSEDATA_" ("_Y_")"
47 S Y=$P(PRSE(2),U)
48 S X=$G(^PRSE(452.51,+Y,0)),X(1)=$P(X,U),X(2)=$P(X,U,2)
49 I X(1)]"",X(2)]"" S PRSEDATA(4)=X(2)_" ("_X(1)_")"
50 S (PRSEDATA,Y)=$P(PRSE(0),U,7),C=$P(^DD(452,6,0),U,2)
51 I Y]"" D Y^DIQ I Y]"" S PRSEDATA(5)=PRSEDATA_" ("_Y_")"
52 S Y=$P(PRSE(0),U,5)
53 S X=$G(^PRSE(452.4,+Y,0)),X(1)=$P(X,U),X(2)=$P(X,U,2)
54 I X(1)]"",X(2)]"" S PRSEDATA(6)=X(2)_" ("_X(1)_")"
55 S Y=$P(PRSE(0),U,2),C=$P(^DD(452,1,0),U,2)
56 I Y]"" D Y^DIQ I Y]"" S PRSEDATA(7)=Y_" ("_PRSETYED_")"
57 S Y=$P(PRSE(0),U,14)
58 S PRSEDATA(8)=$S(Y:$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),1:"")
59 S PRSEDATA(9)=$P(PRSE(0),U,23)
60 I PRSEDATA(9)]"" S PRSEDATA(9)=$J($FN(PRSEDATA(9),","),5)
61 S PRSEDATA(10)=$P(PRSE(0),U,24)
62 I PRSEDATA(10)]"" S PRSEDATA(10)=$J($FN(PRSEDATA(10),","),5)
63 S Y=$P(PRSE(0),U,4),PRSEY=$TR(Y,"NR","AB"),C=$P(^DD(452,20,0),U,2)
64 I Y]"" D Y^DIQ I Y]"" S PRSEDATA(11)=PRSEY_" ("_Y_")"
65 S Y=$P(PRSE(0),U,19) I $P(PRSE(6),U)="L",PRSETYED="C" S Y=+Y
66 I Y]"" S PRSEDATA(12)=$J($FN(Y,",",2),8)
67 S Y=$P(PRSE(0),U,20) I $P(PRSE(6),U)="L",PRSETYED="C" S Y=+Y
68 I Y]"" S PRSEDATA(13)=$J($FN(Y,",",2),8)
69 S Y=$P(PRSE(0),U,8) I $P(PRSE(6),U)="L",PRSETYED="C" S Y=+Y
70 I Y]"" S PRSEDATA(14)=$J($FN(Y,",",2),8)
71 S Y=$P(PRSE(0),U,9),C=$P(^DD(452,8,0),U,2)
72 I Y]"" D Y^DIQ I Y]"" S PRSEDATA(15)=Y
73 S PRSEDATA(16)=$P(PRSE(0),U,10)
74 I PRSEDATA(16)]"" S PRSEDATA(16)=$J($FN(PRSEDATA(16),",",2),8)
75TYPE ;
76 S PRSENODE="1^2^3^4^5^6^7^8^9^10"
77 I $P(PRSE(0),U,16)<8 S PRSENODE=PRSENODE_"^11"
78 I PRSETYED="C" S PRSENODE=PRSENODE_"^12^13^14^15^16"
79 S PRSETYPE(0)="C"
80 F PRSEI=1:1 S PRSE=$P(PRSENODE,U,PRSEI) Q:PRSE'>0!(PRSETYPE(0)="I") D
81 . I $G(PRSEDATA(PRSE))="" S PRSETYPE(0)="I"
82 . Q
83PRINT ;
84 I PRSETYPE=PRSETYPE(0) D
85 . W !
86 . F PRSEI=1:1 S PRSE=$P(PRSENODE,U,PRSEI) Q:PRSE'>0!PRSEQUIT D
87 .. I PRSETYPE="C" D WRITE
88 .. E I $G(PRSEDATA(PRSE))=""!(U_1_U_2_U_7_U_8_U[(U_PRSE_U)) D WRITE
89 .. I $Y>(IOSL-5),$S(PRSEI<$L(PRSENODE,U):1,$O(^TMP("PRSE",$J,PRSESSN,PRSED0))]"":1,$O(^TMP("PRSE",$J,PRSESSN))]"":1,1:0) D PAUSE,HEADER
90 .. Q
91 . Q
92 Q
93WRITE ;
94 W !,PRSETXT(PRSE),?21,$G(PRSEDATA(PRSE)) S PRSEPRNT=1
95 Q
96PAUSE ;
97 I $E(IOST)'="C" Q
98 K DIR S DIR(0)="E" D ^DIR S PRSEQUIT=$S(Y'>0:1,1:0)
99 Q
100HEADER ;
101 I PRSEQUIT Q
102 I ($E(IOST)="C")!(PRSEPAGE>1) W @IOF
103 W !?26,"OLDE TRAINING CODING REPORT",?68,PRSENOW
104 S X=$S(PRSETYPE="C":"COMPLETE",1:"INCOMPLETE")_" DATA FOR "
105 S X=X_$S(TYP="C":"CALENDAR YEAR",TYP="F":"FISCAL YEAR",1:"DATE RANGE")
106 S X=X_" "_$S((TYP="C")!(TYP="F"):PYR,1:YRST(1)_" - "_YREND(1))
107 W !?80-$L(X)/2,X,?68,"PAGE: ",PRSEPAGE,!,PRSEUNDL
108 S PRSEPAGE=PRSEPAGE+1
109 Q
110DATA ;;
111 ;;SSN
112 ;;Student Name
113 ;;Govt Funded
114 ;;Purpose of Training
115 ;;Source of Training
116 ;;Prg/Cls Category
117 ;;Prg/Cls Title
118 ;;Date Prg/Cls Ended
119 ;;Cls Hrs On Duty
120 ;;Cls Hrs Off Duty
121 ;;Routine/Non-Routine
122 ;;Direct Cost
123 ;;Indirect Cost
124 ;;Student Expense
125 ;;Accrediting Org
126 ;;Contact Hours
Note: See TracBrowser for help on using the repository browser.