source: FOIAVistA/trunk/r/PAID-PRS/PRSEED6.m@ 1688

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1PRSEED6 ;HISC/MD-ENTER/EDIT-CLASS REGISTRATION ;12/14/1999
2 ;;4.0;PAID;**5,18,44,53**;Sep 21, 1995
3EN1 ; ENTRY FROM PRSE-CLS-REG
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 K ^TMP("PRSE",$J) S (NOUT,NSW)=0 D EN2^PRSEUTL3($G(DUZ)) I PRSESER="",'(DUZ(0)="@") D MSG3^PRSEMSG G QQ
6SEL S DIR(0)="SO^R:Class Registration Calendar Report;S:Student Registration",DIR("A")="Choose a Selection from the above choices" D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(U[X)!(Y="") QQ
7 I Y="R" S:$G(PRSESLF) SSLF=1 W ! D EN1^PRSECAL,QQ G EN1^PRSEED5:$G(SSLF),EN1
8 E S REGSW=1 D INS^PRSEUTL G:$D(DTOUT)!($D(DUOUT))!(U[X)!(Y="") QQ
9CLAS ; SELECT CLASS IN 452.8 FILE
10 W ! S PRSETYP=PRSESEL,PRSE=0,DIC=452.1,DIC(0)="AEQMZ",DIC("A")="CLASS NAME: ",DIC("S")="I +$$DICS^PRSEUTL(.PRSE)"
11 S DIC("W")="W ?($X+5),$P($G(^PRSP(454.1,+$P(^(0),U,8),0)),U)"
12 D ^DIC K DIC G:X="" EN1 I $D(DTOUT)!($D(DUOUT))!(X=U)!'(Y>0) S POUT=1 G QQ
13 ;
14 S PRSEPROG=Y(0,0),PRSEPROG(1)=Y(0),PRSEMI=+Y,X=$P(Y,U,2),DIC="^PRSE(452.8,",DIC(0)="",DIC("S")="I $P(^(0),U)=PRSEMI" D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S POUT=1 G QQ
15 ;
16 W ! D NOW^%DTC S PRSEDT("NOW")=%,PRSEY=^PRSE(452.8,+Y,0),PRSETYP=$P(^PRSE(452.8,+Y,0),U,5),(PRX,DA(2),PRSEDA)=+Y,Y=$$EN4^PRSEUTL2($G(PRX))
17 S Z=$O(^PRSE(452.8,+PRX,3,"C",0)) I '((9999999-Z)<PRSEDT("NOW")) S DIC("B")=PRSEDT
18 I PRSEDT=0 D MSG20^PRSEMSG G CLAS
19 D NOW^%DTC S PRSEDT("NOW")=%
20 S DA(1)=PRSEDA,DIC(0)="AEMQZ",DIC="^PRSE(452.8,DA(1),3,",DIC("A")="Select DATE: ",DIC("S")="N Z S Z=+$G(^(0)) S:'$P(Z,""."",2) $P(Z,""."",2)=$P(PRSEDT(""NOW""),""."",2) I '(+Z<PRSEDT(""NOW""))"
21 S DIC("W")="W:$P(^(0),U,5)=0 ?($X+1),""* REGISTRATION UNAVAILABLE *"""
22 D ^DIC K DIC I $D(DTOUT)!($D(DUOUT))!(U[X) S POUT=1 G QQ
23 I $D(^PRSE(452.8,DA(2),3,+Y,0)),$P(^(0),U,5)=0 D MSG4^PRSEMSG G CLAS
24 ;
25 S PRSEGLO=$P($G(^PRSE(452.8,0)),U)
26 S PRSEDA(2)=PRSEDA,PRSEDA(1)=+Y I '$D(^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),1,0)) S ^(0)="^452.8894P^^"
27 S PRSEDAT=$P($G(^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0)),U)
28 L +^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0):0 I '$T D MSG^PRSEMSG G CLAS
29 ; register/unregister students
30 K POUT F D STUD Q:X="^"!$G(POUT)
31 L -^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0)
32 G QQ:$G(POUT)
33 G CLAS
34 ;
35STUD ; STUDENT REGISTRATION
36 N VA200 ; ien to file 200 ^ name
37 S DA(2)=PRSEDA,DA(1)=PRSEDA(1)
38 D EN2^PRSEUTL3($G(DUZ)) ; determine user service
39 S DATA=$P($G(^PRSE(452.8,DA(2),3,DA(1),0)),U,5)
40 S DATA(1)=$P($G(^PRSE(452.8,DA(2),3,DA(1),1,0)),U,4)
41 ;
42 I $D(PRSESLF) D S X="^" Q
43 . S PRS("SAV")=+$G(PRSESER)
44 . S:$G(PRSESER) PRSESER=$P($G(^PRSP(454.1,+PRSESER,0)),U)
45 . S PRSEEMP=+DUZ
46 . D ADD
47 . S PRSESER=+$G(PRS("SAV"))
48 . S REGSW=1
49 ;
50 W !!,"Enter STUDENT NAME: " R X:DTIME I (U[X)!(X[U) S X="^" Q
51 S PRSESAVX=X
52 ; if ? then list registered students
53 I PRSESAVX["?" S D="B",DIC="^PRSE(452.8,DA(2),3,DA(1),1,",DIC(0)="EMZ" D DQ^DICQ K DIC S X=PRSESAVX
54 ; perform lookup with X in NEW PERSON file
55 S DIC=200,DIC(0)="EMZ"
56 S DIC("W")="W ?($X+3),$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3(+$G(Y)),0)),U)"
57 D ^DIC K DIC Q:X=U
58 Q:PRSESAVX["?" ; ? was entered so there is no student to process
59 S VA200=Y
60 ;
61 ; if lookup failed
62 I +VA200'>0 D I +VA200'>0 Q
63 . W !,"A NEW PERSON record has not been identified for student ",X,!
64 . ; if laygo allowed then support addition to NEW PERSON
65 . I $P($G(^PRSE(452.7,1,0)),U,3)>0,($G(DUZ(0))["@")!(+$$EN4^PRSEUTL3($G(DUZ))) D Q
66 . . S DIR(0)="Y",DIR("B")="YES"
67 . . S DIR("A")="Do you want to add a non VA employee to the NEW PERSON (#200) file"
68 . . D ^DIR K DIR S:$D(DTOUT)!$D(DUOUT) POUT=1 Q:$D(DIRUT)!'Y
69 . . S VA200=$$ADD^XUSERNEW("9R")
70 . ; laygo not allowed
71 . D MSG15^PRSEMSG
72 ;
73 S PRSESER=$$EN3^PRSEUTL3(+VA200)
74 S PRSESSN=$$GET1^DIQ(200,+VA200,9)
75 I PRSESSN="" W !,$C(7),"NO SSN IN NEW PERSON FILE-CANNOT CONTINUE" W ! Q
76 S DA=$P(^PRSE(452.8,DA(2),3,DA(1),1,0),U,3)+1
77 S (PRDA,PRSEEMP)=+VA200
78 S PRSENAM=$P(VA200,U,2)
79 S PRSESER=$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3($G(PRDA)),0)),U)
80 D ADD
81 Q
82 ;
83ADD ; PREVIOUS ATTENDANCE CHK
84 I +DATA>0,DATA(1)'<DATA,'$D(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP)) D MSG17^PRSEMSG Q
85 N X S DA=($P(^PRSE(452.8,DA(2),3,DA(1),1,0),U,3)+1) I $D(^PRSE(452,"AA",PRSETYP,PRSEEMP,PRSEPROG,(9999999-PRSEDAT))) S Y=PRSEDAT D DD^%DT S PRSEDAT=Y,PRSECLS=PRSEPROG D MSG18^PRSEMSG Q
86 I '$D(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP)) D
87ADD1 .S:PRSESER="" PRSESER="NON-EMPLOYEE" W !!,"Do you want to register "_PRSENAM_" - "_PRSESER_" for",!,PRSEPROG S %=1 D YN^DICN I %=0 W $C(7),!!,"Answer YES or NO." G ADD1
88 .I '(%=1)&'(%=2) S POUT=1 Q
89 .Q
90 I '$G(POUT),$D(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP)) S DA=$O(^(+PRSEEMP,0)) D MSG7^PRSEMSG,DEL^PRSEED3
91 Q:$G(%)=2 I $G(%)=1 K DD,DO S DIC="^PRSE(452.8,DA(2),3,DA(1),1,",DIC("DR")="1////"_PRSESER_";3////"_PRSESSN_";4////^S X=""E""",DIC(0)="L",X=+PRSEEMP,DLAYGO=452.8894 D FILE^DICN
92 Q
93QQ D ^PRSEKILL
94 Q
Note: See TracBrowser for help on using the repository browser.