source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEED0.m@ 1710

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1PRSEED0 ;HISC/MD/JH-SITE FILE ENTER EDIT DRIVER ;9/10/99
2 ;;4.0;PAID;**2,20,44,50**;Sep 21, 1995
3EN2 ; ENTRY FROM OPTION PRSE-MIEX
4 D EN G:$G(POUT) QUIT S PRSETYP="M" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN2
5 S (PRDA,DA)=+Y L +^PRSE(452.8,+PRDA):0 I '$T D MSG14^PRSEMSG G QUIT
6 K DR S DIE=452.8
7 S DR="1///L;6///1;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;2;2.5;10;9;3//GOVERNMENT FUNDED;11//YES;5;D EN1^PRSEUTL4"
8 S DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"
9 D ^DIE
10 L -^PRSE(452.8,+PRDA)
11QUIT K PRSENAM,DIK,PRSETYP,PRSESER,DIC,DIE,DIR,DR,DTOUT,DUOUT,DA,POUT,DO,DD,%,D,D0,DIK,PRSEDA,PRSEFILE,PRSECLS,PRSEGLO,PRSEGOV,PRSEPROG,PRSEX,PRSEY,W,X,Y,Z,%XD1,DC,DDH,DIEL,DIPE,DIZ,DK,DL,DM,DP,DW,PRSEDAT,PRSEMI,PRSEDEF,PRSELOC,PRSELEN D ^%ZISC
12 K PSPC,PRSEDONE,PRSESTRT,PRSECORD,PRDA,ZZ,PRSENEW
13 Q
14EN3 ; ENTRY FROM OPTION PRSE-M.I.
15 D EN G:$G(POUT) QUIT S PRSETYP="M" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN3
16 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT
17 S DIE=452.8,DR="1///L;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;11///NO;D EN1^PRSEUTL4",DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"
18 D ^DIE
19 L -^PRSE(452.8,PRDA)
20 G QUIT
21EN4 ; ENTRY FROM OPTION PRSE-C.E.
22 D EN G:$G(POUT) QUIT S PRSETYP="C" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN4
23 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT
24 S DIE=452.8
25 S DR="1///L;6///1;89;15///^S X=PRSELEN;7;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;7.5;7.6;77;2;10;9;3//GOVERNMENT FUNDED;11//YES;5"
26 S DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"
27 D ^DIE
28 L -^PRSE(452.8,PRDA)
29 G QUIT
30EN5 ; ENTRY FROM OPTION PRSE-W.I.
31 D EN G:$G(POUT) QUIT S PRSETYP="W" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN5
32 N PRDALOC
33 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT
34 S PRDALOC=$G(PRDA)
35 S DIE=452.8,DR="1///L;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;11///NO",DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;@1;3.1" D ^DIE
36 D ATTEND^PRSEED0
37 L -^PRSE(452.8,PRDALOC)
38 G QUIT
39ATTEND K POUT W !!,"Do you want to credit students for attending this class" S %=1 D YN^DICN I %=0 W $C(7),!!,"Answer YES or NO." G ATTEND
40 I %=1 S PRDA(2)=DA,PRSEY=^PRSE(452.8,PRDA(2),0) N DP,DIE,DA,DQ,DI,DR,DL W ! S PRSEPROG=$P($G(^PRSE(452.1,+PRSEMI,0)),U),PRSEPROG(1)=$G(^PRSE(452.1,+PRSEMI,0)) D DATE^PRSEED8
41 Q
42EN6 ; ENTRY FROM OPTION PRSE-O.I.
43 D EN G:$G(POUT) QUIT S PRSETYP="O",PRSESER=+$G(^VA(200,DUZ,5)) I PRSESER="" D MSG3^PRSEMSG G QUIT
44 D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN6
45 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT
46 S DIE=452.8
47 S DR="1///L;6///1;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;2;10;9;3//GOVERNMENT FUNDED;11//NO;5",DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"
48 D ^DIE K DIE,DR
49 L -^PRSE(452.8,PRDA)
50 G QUIT
51SELSVC ; DETERMINE SERVICE
52 D EN2^PRSEUTL3($G(DUZ)) I PRSESER="",'(DUZ(0)["@") D MSG3^PRSEMSG S POUT=1
53 Q
54LOC ; LOCATION SELECTION
55 I X=U!($G(POUT)) S Y=0 Q
56 S PRSEDEF="",PRSEDEF=$P($G(^PRSE(452.8,DA(1),3,DA,0)),U,2)
57 S PRSENAM=$P($G(^PRSE(452.8,DA(1),3,DA,0)),U,4) I '(PRSENAM=""),$D(^VA(200,"B",PRSENAM)),$G(PRSEDEF)="" S PRSEDEF=$P(^PRSE(452.7,1,0),U,2)
58 I PRSEDEF="",'($D(VA(200,"B",PRSENAM))),'(PRSENAM=""),$D(^PRSE(452.2,"B",PRSENAM)) D
59 . S PRSEDA=$O(^PRSE(452.2,"B",PRSENAM,0)) I $D(^PRSE(452.2,+PRSEDA,0)) S PRSEZ=^(0) S:'($P(PRSEZ,U,3)="") PRSEDEF=$P(PRSEZ,U,3)_","_$S($D(^DIC(5,+$P(PRSEZ,U,4),0)):$P(^(0),U,2),1:"")
60 . Q
61ASK W !?2,"LOCATION OF PRESENTATION: "_$S('(PRSEDEF=""):PRSEDEF_"//",1:"") R X:DTIME I '$T!(X="^") S Y=0 Q
62 I X="@" S $P(^PRSE(452.8,DA(1),3,DA,0),U,2)="" G LOC
63 I X="",'(PRSEDEF="") S X=PRSEDEF
64 I $S(X["?":1,($L(X)<3):1,($L(X)>30):1,1:0) W !!,$C(7),?3,"Answer must be 3-30 characters in length.",!,?2,"This field contains the location where the Program/Class is to be held.",! G ASK
65 S PRSELOC=$S('(X=""):X,X=""&'(PRSEDEF=""):PRSEDEF,1:PRSELOC)
66 K PRSENAM
67 Q
68EN ;
69 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG S POUT=1
70 Q
Note: See TracBrowser for help on using the repository browser.