source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEED10.m@ 623

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRSEED10 ;HISC/MD/MH-PRSE NON-LOCAL C.E. ATTENDANCE ;06/15/94
2 ;;4.0;PAID;**18,23**;Sep 21, 1995
3EN1 ; ENTRY FROM OPTION PRSE-NCEATTEND
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 K ^TMP($J) S (PRSESW,NOUT)=0,PRSESEL="C",(PRSECOD,PRSELCL,PRSEROU)="N",PRSEGF="G" D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q1
6OTHER D SCUB G:PRSENAM=""!(PRSEDT="")!("^^"[X) Q1
7ASK K POUT D NAM G:$D(POUT) EN1
8 S (NSW,NDUPSW)=0,PRSENAM(0)=PRSENAM D RECHK^PRSEED7 G:NOUT EN1
9 I 'NDUPSW S DIC("S")="I $P($G(^(0)),U,7)=PRSESEL" S PRSESEL="C",(PRSECOD,PRSELCL)="N",PRSEGF="G",PRSEROU="N" K POUT D ADD^PRSEED12 G Q1:$G(POUT)
10 S X="",PRSESEL="C",(PRSECOD,PRSELCL)="N",PRSEGF="G",PRSEROU="N" G ASK
11Q1 W ! D ^PRSEKILL
12 Q
13NAM ;
14 K POUT,X,Y
15 I $S($G(DUZ(0))["@":1,+$$EN4^PRSEUTL3($G(DUZ)):1,1:0) I $P($G(^PRSE(452.7,1,0)),U,3) D Q:$G(POUT) G NAM1
16 . W !
17 . S Y=$$ADD^XUSERNEW(9)
18 . I $G(Y)'>0 S POUT=1
19 ;
20 I $S($P($G(^PRSE(452.7,1,0)),U,3)'>0:1,'+$$EN4^PRSEUTL3($G(DUZ)):1,$G(DUZ(0))'["@":1,1:0) D
21 . W !!,$C(7),"NEW ENTRIES CANNOT BE ADDED TO THE NEW PERSON FILE FROM THIS OPTION - CONTACT",!,"THE EDUCATION PACKAGE COORDINATOR OR IRM OR SELECT A NAME ALREADY IN FILE.",!
22 . S DIC("A")="Select Student Name: "
23 . S DIC=200,DIC(0)="AEQM"
24 . W ! D ^DIC I X=""!(X["^")!(+Y'>0) K DIC S POUT=1 Q
25 . S PRDA(0)=Y
26 . ;S DIE=DIC,DA=+Y,DR="9R" D ^DIE K DIC,DIE,DR,DA
27 . S Y=PRDA(0)
28 ;
29NAM1 Q:$D(POUT)
30 I $G(Y)'>0 G NAM
31 S (PRDA,VA200DA)=+Y
32 S PRSESTUD=$P($G(^VA(200,+Y,0)),U),(SSN,PRSESSN)=$P($G(^VA(200,+Y,1)),U,9) I $G(PRSESSN)="" W !!,"NO SSN OR NEW PERSON (#200) FILE ENTRY FOR THIS EMPLOYEE-CANNOT CONTINUE" G NAM
33 S PDA(1)=$S((+$O(^PRSPC("SSN",PRSESSN,0))>0):$O(^PRSPC("SSN",PRSESSN,0)),1:"")
34 S PRSESRCE="NON-GOVERNMENT (e.g. Institution, Company or University)"
35 ;
36 ;get service of user taking non-local course
37 D EN2^PRSEUTL3($G(VA200DA)) ;returns PRSESER,PRSESER("TX")
38 ;PRSESER=ien of service (454.1)
39 ;PRSESER("TX")=name of service
40 I PRSESER="" S PRSESER("TX")="NON-EMPLOYEE" ;no CC/Org code
41 Q
42SCUB ;
43 K DA,DIC,DR,DIE,POUT S (PRSENAM,PRSEDT)="",PRSESW=0
44 F K POUT,PRSEY,PRSEED S Y=-1 R !!,"Select NON-LOCAL C.E. CLASS: ",X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:Y'=""!(Y<0)
45 . S DIC("S")="S DATA=$G(^PRSE(452,Y,0)) I $P($G(^PRSE(452,+Y,6)),U)=""N"",$P(DATA,U,21)=""C"""
46 . S DIC("W")="W ?($X+4),$P($G(^(0)),U,13)"
47 . S DIC=452,DLAYGO=452,DIC(0)=$E("SZE",1,(X'=" ")+2),D="AK" D IX^DIC K DIC S PRSEDA=+Y I X?1"?".E!(Y>0) W:X=" " " ",$P(Y(0),U,2) S Y=$S(Y>0:$P(Y(0),U,2),1:"") Q
48 . I $G(X)'="",$G(X)'=" ",$L(X)<2!($L(X)>53) W !!,$C(7),"Answer should be between 2 and 53 characters" S Y="" Q
49 . I X=" ",'(+Y>0)!($L(X)<2) S POUT=1 Q
50 . S X=$$UP^XLFSTR(X)
51 . F W !?3,"ARE YOU ADDING '"_X_"' AS A NEW CLASS" S %=0 D YN^DICN Q:% W !?7,"ANSWER YES OR NO."
52 . S Y=$S(%=1:X,%=2:"",1:-1)
53 . Q
54 Q:Y=""!(Y<0) S PRSENAM=Y K Y
55DATE D EN4^PRSEUTL1($G(PRSENAM)) F S Y=-1 W !!,"Select CLASS DATE: "_$S($G(PRSEY(1))'="":PRSEY(1)_"// ",1:"") R X:DTIME S:'$T X="^^" S:X=""&(+$G(PRSEY)) X=$G(PRSEY) S:X=""&'(+$G(PRSEY)>0) Y="" Q:"^^"[X D Q:Y'=""!(Y<0)
56 . I X'?1"?".E S %DT="ET" D ^%DT S:Y'>0 Y="" Q:+Y>DT!(Y'>0) D Q
57 . . S X=Y,Y=$S($O(^PRSE(452,"AL"_PRSENAM,Y,0)):Y,1:"") Q:Y>0
58 . . F W !?3,"ARE YOU ADDING '" S Y=X D DT^DIQ W "' AS A NEW CLASS DATE" S %=0 D YN^DICN Q:% W !?7,"ANSWER YES OR NO."
59 . . S Y=$S(%=1:X,%=2:"",1:-1)
60 . . Q
61 . W @IOF S (Z,X)=0 F S X=$O(^PRSE(452,"AL"_PRSENAM,X)) Q:X'>0!Z S PRSEDA=0 F S PRSEDA=$O(^PRSE(452,"AL"_PRSENAM,X,PRSEDA)) Q:PRSEDA'>0 D Q:Z
62 . . S Y=$P($G(^PRSE(452,PRSEDA,0)),U,3) W !?8 D DT^DIQ
63 . . I $Y>(IOSL-3) R !?8,"""^"" TO STOP: ",Z:DTIME S:'$T Z="^^" S Z=(Z="^"!(Z="^^")) W @IOF
64 . . Q
65 . S %DT="ET" D HELP^%DTC
66 . S Y=""
67 . Q
68 Q:Y=""!(Y<0) D NOW^%DTC I +Y>% W $C(7),!,"You cannot take attendance for a class with a future date!" G DATE
69 S PRSEDT=Y
70 Q
Note: See TracBrowser for help on using the repository browser.