source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEUTL1.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1PRSEUTL1 ;HISC/JH/MD-EDUCATION GLOBOL SEARCH UTILITY ;22-JAN-1998
2 ;;4.0;PAID;**35**;Sep 21, 1995
3EN2 ; NEW PERSON/SUPPLIER-PRESENTER FILE LOOKUP FOR REGISTRATIONS
4 N Y,PRSESAVX S POUT=0,PRSENAM=$P($G(^PRSE(452.8,DA(1),3,DA,0)),U,4) W !,?2,"PRESENTER/SUPPLIER: "_$S(PRSENAM="":"",1:PRSENAM_"// ") R PRSX:DTIME I '$T!(PRSX="^") S POUT=1 Q
5 I PRSX="",$G(PRSENAM)'="" S PRSX=PRSENAM Q
6 I PRSX="@" S PRSENAM=PRSX Q
7 S (X,PRSESAVX)=PRSX
8 S DIC=200,DIC(0)="EMZ" D ^DIC K DIC I $D(DTOUT) S POUT=1 Q
9 S %="" I +Y>0 D Q:Y
10 .F D Q:%
11 ..W !!?5,"Is this the one you want" S %=2 D YN^DICN I '% W !!?10,"Answer Y(es) or N(o)"
12 .I %=1 S PRSENAM=Y(0,0) Q
13 .S Y=0 Q
14 S X=PRSESAVX I X'="",X'["?",$G(%)'="" W !!,X
15 S:+$P($G(^PRSE(452.7,1,0)),U,4) DLAYGO=452.2 S DIC=452.2,DIC(0)="QEMZ"_$S(+$P($G(^PRSE(452.7,1,0)),U,4):"L",1:"") D ^DIC D:+Y'>0&(PRSESAVX]"")&(DIC(0)'["L") MSG5^PRSEMSG K DIC I $D(DTOUT) S POUT=1 Q
16 I $P(Y,U,3) S PRSENAM=Y(0,0) Q
17 I +Y>0 D Q:Y
18 .F D Q:%
19 ..W !!?5,"Is this the one you want" S %=2 D YN^DICN I '% W !!?10,"Answer Y(es) or N(o)"
20 .I %=1 S PRSENAM=Y(0,0) Q
21 .S Y=0 Q
22 G:X["?" EN2 I Y'>0,PRSESAVX]"" G EN2
23 Q
24SRT ;SORT BY DATE OR CLASS TITLE
25 S DIR(0)="SO^D:Date/Time;C:Class Title",DIR("A")="Select Sort Parameter(s)" D ^DIR K DIR I $D(DUOUT)!$D(DTOUT)!("^"[X) S POUT=1 Q
26 S PRSESEL=Y
27 Q
28EN3 ; SERVICE LOOKUP
29 W ! S PSP=0,DIC=454.1,DIC(0)="AEQZ",DIC("A")="Select SERVICE (Press Return for all Services): " D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S POUT=1 Q
30 I '$D(DTOUT),X="" S PSP=1 Q
31 I $D(DTOUT)!(X["^^") S POUT=1 Q
32 S PSPC=$P($G(Y),U,2),PSPC(1)=+Y
33 S:PSPC="MISCELLANEOUS" PSPC="NON-EMPLOYEE"
34 Q
35EN4(PRSENAM) ; LATEST PAST DATE FROM 452 FILE
36 N Y S Y=$S(+$O(^PRSE(452,"DAT",PRSENAM,0))>0:(9999999-$O(^PRSE(452,"DAT",PRSENAM,0))),1:"") I +Y>0 S PRSEY=Y D D^DIQ S PRSEY(1)=Y
37 Q
38EN5 ; ADD ENTRY TO PROGRAM CLASS FILE FROM E/E STUDENT RECORD
39 Q:$G(PRSENAM)="" S PRSEDA(2)="" W !,$C(7),"There is no entry for ",PRSENAM(0)," in the PRSE Program Class #452.1 File.",!,"Would you like to add this entry" D YN^DICN
40 I %=0 W !!,"ANSWER 'YES' or 'NO'" G EN5
41 I %=1 D
42 . S X=PRSENAM,DIC(0)="L",DIC="^PRSE(452.1,",DLAYGO=452.1
43 . S DIC("DR")="5////"_$G(PRSESEL)_";4////1;7////1"
44 . K DD,DO D FILE^DICN K DIC S PRSEDA(2)=+Y
45 . S DIE="^PRSE(452.1,",DA=PRSEDA(2)
46 . S DR=".01////"_PRSENAM_";.5"_$S($$EN11^PRSEUTL3($E(PRSENAM,1,25),DA)'>0:"////"_$E(PRSENAM,1,25),1:"")_";1;3;8"
47 . D ^DIE K PRSEDUPL
48 . Q
49 S POUT=1
50 Q
51EN6 ; SORT SELECTION
52 S DIR(0)="SO^C:(C)lass/Student;S:(S)tudent/Class",DIR("A")="Sort By" D ^DIR Q:+$G(DIRUT) S PRSESORT=Y
53 Q
54EN7 ; ED. TRACKING REPORT PROMPTS
55 K DUOUT,DTOUT
56 W ! S NSP=0,PRSECLS="",DIC("A")="Select TRAINING CLASS (Press return for all classes): "
57 S PRSECLS="",NSP=0,DIC="^PRSE(452.1,",DIC(0)="AEMQZ",DIC("W")="W ?$X+3,$P($G(^PRSP(454.1,+$P($G(^(0)),U,8),0)),U)" D ^DIC K DIC
58 I '$D(DTOUT),'$D(DUOUT),X="" S NSP=1 Q
59 I $D(DTOUT)!($D(DUOUT))!(+Y'>0) S POUT=1 Q
60 S (PRSECLS,NSPC)=$G(Y(0,0)),PRSECLS(0)=+Y
61 Q
Note: See TracBrowser for help on using the repository browser.