source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEED1.m@ 738

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PRSEED1 ;HISC-MD/ENTER-EDIT STUDENT RECORD ; MAY 93
2 ;;4.0;PAID;**18**;Sep 21, 1995
3EN1 ; ENTRY FROM OPTION PRSE-I-EMP
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 K ^TMP($J) S (PRSESW,NOUT,NSW)=0,PRSESRCE="VA",PRSEGF="GOVERNMENT FUNDED",PRSELCL="L",PRSECOD="N" D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q1
6TYPE S DIR(0)="SO^M:Mandatory Training (MI);C:Continuing Education;O:Other/Miscellaneous;W:Ward/Unit-Location Training",DIR("A")="Select a Training Type" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(U[X) S POUT=1 G Q1
7 S PRSESEL=Y
8OTHER S NOUT=0 D SCUB G:"^^"[X!($D(POUT)) TYPE
9ASK D NAM I $D(POUT) K POUT G OTHER
10 S (NSW,NDUPSW)=0,PRSENAM=$S($D(^PRSE(452.1,"B",PRSENAM)):"`"_$O(^PRSE(452.1,"B",PRSENAM,0)),1:PRSENAM) D RECHK^PRSEED7 G:NOUT OTHER I 'NDUPSW S DIC("S")="I $P($G(^(0)),U,7)=PRSESEL" K POUT D ADD^PRSEED12 G Q1:$G(POUT)
11 S PRSENAM=PRSENAM(0)
12 I '+$O(^PRSE(452.6,"B","MANDATORY TRAINING",0)) S:'$D(^PRSE(452.6,0)) ^(0)="PRSE SVC REASONS FOR TRAINING^452.6^0^0" S X="MANDATORY TRAINING",DIC(0)="L",DIC="^PRSE(452.6,",DLAYGO=452.6 K DD,DO D FILE^DICN
13 I 'NDUPSW,'NSW W !?9,PRSENAM(0)," ",PRSESTUD," " S Y=PRSEDT D DT^DIQ S NSW=1
14 G ASK
15Q1 W ! D ^PRSEKILL
16 Q
17NAM ;
18 K POUT,X,Y
19 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
20 . W !
21 . S Y=$$ADD^XUSERNEW(9)
22 . I $G(Y)'>0 S POUT=1
23 ;
24 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 I $G(NAMOUT) K NAMOUT G NAM
25 . R !,"Select Student Name: ",X:DTIME
26 . I X=""!($E(X)="^") S POUT=1 Q
27 . S DIC=200,DIC(0)="EQM"
28 . W ! D ^DIC I +Y'>0 K DIC S NAMOUT=1 D Q
29 . . W !?5,"Student ",X," could not be found in file. Contact the",!?5,"Education Package Coordinator or IRM to add new entries.",!
30 . S PRDA(0)=Y
31 . ;S DIE=DIC,DA=+Y,DR="9R" D ^DIE K DIC,DIE,DR,DA
32 . S Y=PRDA(0)
33 ;
34NAM1 Q:$G(POUT)
35 I $G(Y)'>0 G NAM
36 S PRSESTUD=$P(Y,U,2),VA200DA=+Y
37 S (PRSESSN,SSN)=$P($G(^VA(200,VA200DA,1)),U,9)
38 I PRSESSN="" W $C(7),!,"NO SSN FOR THIS STUDENT-CANNOT CONTINUE" G NAM
39 I $G(SSN)'="" S PRDA=$O(^PRSPC("SSN",SSN,0)) I PRDA>0,$P($G(^PRSPC(+PRDA,0)),U,49)="" D MSG3^PRSEMSG G NAM
40 S PRSESER=$$EN3^PRSEUTL3($G(VA200DA)) S:PRSESER="" PRSESER("TX")="NON-EMPLOYEE"
41 S PRDA=+$G(VA200DA)
42 Q:$D(POUT)
43 S PRSPDA(1)=$S('+$G(PRSESSN):"",(+$O(^PRSPC("SSN",PRSESSN,0))>0):$O(^PRSPC("SSN",PRSESSN,0)),1:"")
44 I $S($G(NOUT):1,$G(X)="?":1,1:0) G NAM
45 I PRSESEL="M",'(+PRSPDA(1)>0) D WRT Q
46 I $P($G(^PRSPC(+PRSPDA(1),1)),U,33)="Y" D WRT Q ;quit if separation=Y
47 I '$G(VA200DA) W $C(7),!!,"STUDENT NOT IN NEW PERSON FILE-CANNOT CONTINUE" S POUT=1 Q
48 Q
49SCUB ;
50 S (PRSENAM,PRSEDT)=""
51 F K POUT S Y=-1 R !!,"Select TRAINING CLASS: ",X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:Y]""
52 .S DIC("S")="S DATA=$G(^PRSE(452,Y,0)),PRSEIEN=$G(^PRSE(452,""AK"",$P($G(DATA),U,2),Y)) I ($P($G(^PRSE(452,+Y,6)),U)=""L""!($G(^(6))="""")),$P(DATA,U,21)=PRSESEL,(PRSEIEN=$G(PRSESER)!(DUZ(0)[""@""!(+$$EN4^PRSEUTL3($G(DUZ)))))"
53 .S DIC("W")="W ?($X+4),$P($G(^PRSE(452,+Y,0)),U,13)"
54 .S DLAYGO=452,DIC=452,DIC(0)=$E("SZE",1,(X'=" ")+2),D="AK" D IX^DIC K DIC I X?1"?".E!(Y>0) W:X=" " " ",$P(Y(0),U,2) S PRSEPREV=Y,Y=$S(Y>0:$P(Y(0),U,2),1:"") Q
55 .I X=" ",'(+Y>0)!($L(X)<3) S POUT=1 Q
56 .I '(+Y>0) W !!?3,$C(7),"'"_X_"' IS NOT CURRENTLY IN THE STUDENT TRACKING #452 FILE" S (X,Y)="",POUT=1 Q
57 Q:Y=""!(Y<0)!($D(POUT)) S PRSENAM=Y K Y
58 D EN4^PRSEUTL1($G(PRSENAM)) F K POUT 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)
59 .I X'?1"?".E S %DT="T" D ^%DT S:Y'>0 Y="" Q:Y'>0 D Q
60 ..S X=Y,Y=$O(^PRSE(452,"AL"_PRSENAM,+X,0)) I Y>0 W " " S Y=X D DT^DIQ Q
61 ..W !!?3,$C(7),PRSENAM_" IS NOT LISTED FOR THIS DATE " S POUT=1 Q
62 .W @IOF S (Z,X)=0 F S X=$O(^PRSE(452,"AL"_PRSENAM,X)) Q:X'>0!Z S DA=0 F S DA=$O(^PRSE(452,"AL"_PRSENAM,X,DA)) Q:DA'>0 D Q:Z
63 ..S Y=$P($G(^PRSE(452,DA,0)),U,3) W !?8 D DT^DIQ
64 ..I $Y>(IOSL-3) R !?8,"""^"" TO STOP: ",Z:DTIME S:'$T Z="^^" S Z=(Z="^"!(Z="^^")) W @IOF
65 ..Q
66 .S %DT="ET" D HELP^%DTC
67 .S Y=""
68 .Q
69 Q:Y=""!(Y<0) S PRSEDT=+X,PRSEDA=$O(^PRSE(452,"AL"_PRSENAM,PRSEDT,0)) Q:'(PRSEDA>0)
70 Q
71 ;
72WRT W $C(7),!!,"CANNOT PROCESS NON-EMPLOYEE FOR MI CLASSES" S POUT=1 Q
Note: See TracBrowser for help on using the repository browser.