- 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 23, 2025@18:41:24 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
