PRSEUTL1 ;HISC/JH/MD-EDUCATION GLOBOL SEARCH UTILITY ;22-JAN-1998
;;4.0;PAID;**35**;Sep 21, 1995
EN2 ; NEW PERSON/SUPPLIER-PRESENTER FILE LOOKUP FOR REGISTRATIONS
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
I PRSX="",$G(PRSENAM)'="" S PRSX=PRSENAM Q
I PRSX="@" S PRSENAM=PRSX Q
S (X,PRSESAVX)=PRSX
S DIC=200,DIC(0)="EMZ" D ^DIC K DIC I $D(DTOUT) S POUT=1 Q
S %="" I +Y>0 D Q:Y
.F D Q:%
..W !!?5,"Is this the one you want" S %=2 D YN^DICN I '% W !!?10,"Answer Y(es) or N(o)"
.I %=1 S PRSENAM=Y(0,0) Q
.S Y=0 Q
S X=PRSESAVX I X'="",X'["?",$G(%)'="" W !!,X
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
I $P(Y,U,3) S PRSENAM=Y(0,0) Q
I +Y>0 D Q:Y
.F D Q:%
..W !!?5,"Is this the one you want" S %=2 D YN^DICN I '% W !!?10,"Answer Y(es) or N(o)"
.I %=1 S PRSENAM=Y(0,0) Q
.S Y=0 Q
G:X["?" EN2 I Y'>0,PRSESAVX]"" G EN2
Q
SRT ;SORT BY DATE OR CLASS TITLE
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
S PRSESEL=Y
Q
EN3 ; SERVICE LOOKUP
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
I '$D(DTOUT),X="" S PSP=1 Q
I $D(DTOUT)!(X["^^") S POUT=1 Q
S PSPC=$P($G(Y),U,2),PSPC(1)=+Y
S:PSPC="MISCELLANEOUS" PSPC="NON-EMPLOYEE"
Q
EN4(PRSENAM) ; LATEST PAST DATE FROM 452 FILE
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
Q
EN5 ; ADD ENTRY TO PROGRAM CLASS FILE FROM E/E STUDENT RECORD
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
I %=0 W !!,"ANSWER 'YES' or 'NO'" G EN5
I %=1 D
. S X=PRSENAM,DIC(0)="L",DIC="^PRSE(452.1,",DLAYGO=452.1
. S DIC("DR")="5////"_$G(PRSESEL)_";4////1;7////1"
. K DD,DO D FILE^DICN K DIC S PRSEDA(2)=+Y
. S DIE="^PRSE(452.1,",DA=PRSEDA(2)
. S DR=".01////"_PRSENAM_";.5"_$S($$EN11^PRSEUTL3($E(PRSENAM,1,25),DA)'>0:"////"_$E(PRSENAM,1,25),1:"")_";1;3;8"
. D ^DIE K PRSEDUPL
. Q
S POUT=1
Q
EN6 ; SORT SELECTION
S DIR(0)="SO^C:(C)lass/Student;S:(S)tudent/Class",DIR("A")="Sort By" D ^DIR Q:+$G(DIRUT) S PRSESORT=Y
Q
EN7 ; ED. TRACKING REPORT PROMPTS
K DUOUT,DTOUT
W ! S NSP=0,PRSECLS="",DIC("A")="Select TRAINING CLASS (Press return for all classes): "
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
I '$D(DTOUT),'$D(DUOUT),X="" S NSP=1 Q
I $D(DTOUT)!($D(DUOUT))!(+Y'>0) S POUT=1 Q
S (PRSECLS,NSPC)=$G(Y(0,0)),PRSECLS(0)=+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEUTL1 3004 printed Apr 09, 2024@21:29:25 Page 2
PRSEUTL1 ;HISC/JH/MD-EDUCATION GLOBOL SEARCH UTILITY ;22-JAN-1998
+1 ;;4.0;PAID;**35**;Sep 21, 1995
EN2 ; NEW PERSON/SUPPLIER-PRESENTER FILE LOOKUP FOR REGISTRATIONS
+1 NEW Y,PRSESAVX
SET POUT=0
SET PRSENAM=$PIECE($GET(^PRSE(452.8,DA(1),3,DA,0)),U,4)
WRITE !,?2,"PRESENTER/SUPPLIER: "_$SELECT(PRSENAM="":"",1:PRSENAM_"// ")
READ PRSX:DTIME
IF '$TEST!(PRSX="^")
SET POUT=1
QUIT
+2 IF PRSX=""
IF $GET(PRSENAM)'=""
SET PRSX=PRSENAM
QUIT
+3 IF PRSX="@"
SET PRSENAM=PRSX
QUIT
+4 SET (X,PRSESAVX)=PRSX
+5 SET DIC=200
SET DIC(0)="EMZ"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)
SET POUT=1
QUIT
+6 SET %=""
IF +Y>0
Begin DoDot:1
+7 FOR
Begin DoDot:2
+8 WRITE !!?5,"Is this the one you want"
SET %=2
DO YN^DICN
IF '%
WRITE !!?10,"Answer Y(es) or N(o)"
End DoDot:2
if %
QUIT
+9 IF %=1
SET PRSENAM=Y(0,0)
QUIT
+10 SET Y=0
QUIT
End DoDot:1
if Y
QUIT
+11 SET X=PRSESAVX
IF X'=""
IF X'["?"
IF $GET(%)'=""
WRITE !!,X
+12 if +$PIECE($GET(^PRSE(452.7,1,0)),U,4)
SET DLAYGO=452.2
SET DIC=452.2
SET DIC(0)="QEMZ"_$SELECT(+$PIECE($GET(^PRSE(452.7,1,0)),U,4):"L",1:"")
DO ^DIC
if +Y'>0&(PRSESAVX]"")&(DIC(0)'["L")
DO MSG5^PRSEMSG
KILL DIC
IF $DATA(DTOUT)
SET POUT=1
QUIT
+13 IF $PIECE(Y,U,3)
SET PRSENAM=Y(0,0)
QUIT
+14 IF +Y>0
Begin DoDot:1
+15 FOR
Begin DoDot:2
+16 WRITE !!?5,"Is this the one you want"
SET %=2
DO YN^DICN
IF '%
WRITE !!?10,"Answer Y(es) or N(o)"
End DoDot:2
if %
QUIT
+17 IF %=1
SET PRSENAM=Y(0,0)
QUIT
+18 SET Y=0
QUIT
End DoDot:1
if Y
QUIT
+19 if X["?"
GOTO EN2
IF Y'>0
IF PRSESAVX]""
GOTO EN2
+20 QUIT
SRT ;SORT BY DATE OR CLASS TITLE
+1 SET DIR(0)="SO^D:Date/Time;C:Class Title"
SET DIR("A")="Select Sort Parameter(s)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!$DATA(DTOUT)!("^"[X)
SET POUT=1
QUIT
+2 SET PRSESEL=Y
+3 QUIT
EN3 ; SERVICE LOOKUP
+1 WRITE !
SET PSP=0
SET DIC=454.1
SET DIC(0)="AEQZ"
SET DIC("A")="Select SERVICE (Press Return for all Services): "
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET POUT=1
QUIT
+2 IF '$DATA(DTOUT)
IF X=""
SET PSP=1
QUIT
+3 IF $DATA(DTOUT)!(X["^^")
SET POUT=1
QUIT
+4 SET PSPC=$PIECE($GET(Y),U,2)
SET PSPC(1)=+Y
+5 if PSPC="MISCELLANEOUS"
SET PSPC="NON-EMPLOYEE"
+6 QUIT
EN4(PRSENAM) ; LATEST PAST DATE FROM 452 FILE
+1 NEW Y
SET Y=$SELECT(+$ORDER(^PRSE(452,"DAT",PRSENAM,0))>0:(9999999-$ORDER(^PRSE(452,"DAT",PRSENAM,0))),1:"")
IF +Y>0
SET PRSEY=Y
DO D^DIQ
SET PRSEY(1)=Y
+2 QUIT
EN5 ; ADD ENTRY TO PROGRAM CLASS FILE FROM E/E STUDENT RECORD
+1 if $GET(PRSENAM)=""
QUIT
SET PRSEDA(2)=""
WRITE !,$CHAR(7),"There is no entry for ",PRSENAM(0)," in the PRSE Program Class #452.1 File.",!,"Would you like to add this entry"
DO YN^DICN
+2 IF %=0
WRITE !!,"ANSWER 'YES' or 'NO'"
GOTO EN5
+3 IF %=1
Begin DoDot:1
+4 SET X=PRSENAM
SET DIC(0)="L"
SET DIC="^PRSE(452.1,"
SET DLAYGO=452.1
+5 SET DIC("DR")="5////"_$GET(PRSESEL)_";4////1;7////1"
+6 KILL DD,DO
DO FILE^DICN
KILL DIC
SET PRSEDA(2)=+Y
+7 SET DIE="^PRSE(452.1,"
SET DA=PRSEDA(2)
+8 SET DR=".01////"_PRSENAM_";.5"_$SELECT($$EN11^PRSEUTL3($EXTRACT(PRSENAM,1,25),DA)'>0:"////"_$EXTRACT(PRSENAM,1,25),1:"")_";1;3;8"
+9 DO ^DIE
KILL PRSEDUPL
+10 QUIT
End DoDot:1
+11 SET POUT=1
+12 QUIT
EN6 ; SORT SELECTION
+1 SET DIR(0)="SO^C:(C)lass/Student;S:(S)tudent/Class"
SET DIR("A")="Sort By"
DO ^DIR
if +$GET(DIRUT)
QUIT
SET PRSESORT=Y
+2 QUIT
EN7 ; ED. TRACKING REPORT PROMPTS
+1 KILL DUOUT,DTOUT
+2 WRITE !
SET NSP=0
SET PRSECLS=""
SET DIC("A")="Select TRAINING CLASS (Press return for all classes): "
+3 SET PRSECLS=""
SET NSP=0
SET DIC="^PRSE(452.1,"
SET DIC(0)="AEMQZ"
SET DIC("W")="W ?$X+3,$P($G(^PRSP(454.1,+$P($G(^(0)),U,8),0)),U)"
DO ^DIC
KILL DIC
+4 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF X=""
SET NSP=1
QUIT
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
SET POUT=1
QUIT
+6 SET (PRSECLS,NSPC)=$GET(Y(0,0))
SET PRSECLS(0)=+Y
+7 QUIT
