PRSEED0.m

PRSEED0 ;HISC/MD/JH-SITE FILE ENTER EDIT DRIVER ;9/10/99

 ;;4.0;PAID;**2,20,44,50**;Sep 21, 1995

EN2 ; ENTRY FROM OPTION PRSE-MIEX

 D EN G:$G(POUT) QUIT S PRSETYP="M" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN2

 S (PRDA,DA)=+Y L +^PRSE(452.8,+PRDA):0 I '$T D MSG14^PRSEMSG G QUIT

 K DR S DIE=452.8

 S DR="1///L;6///1;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;2;2.5;10;9;3//GOVERNMENT FUNDED;11//YES;5;D EN1^PRSEUTL4"

 S DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 D ^DIE

 L -^PRSE(452.8,+PRDA)

QUIT K PRSENAM,DIK,PRSETYP,PRSESER,DIC,DIE,DIR,DR,DTOUT,DUOUT,DA,POUT,DO,DD,%,D,D0,DIK,PRSEDA,PRSEFILE,PRSECLS,PRSEGLO,PRSEGOV,PRSEPROG,PRSEX,PRSEY,W,X,Y,Z,%XD1,DC,DDH,DIEL,DIPE,DIZ,DK,DL,DM,DP,DW,PRSEDAT,PRSEMI,PRSEDEF,PRSELOC,PRSELEN D ^%ZISC

 K PSPC,PRSEDONE,PRSESTRT,PRSECORD,PRDA,ZZ,PRSENEW

 Q

EN3 ; ENTRY FROM OPTION PRSE-M.I.

 D EN G:$G(POUT) QUIT S PRSETYP="M" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN3

 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT

 S DIE=452.8,DR="1///L;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;11///NO;D EN1^PRSEUTL4",DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 D ^DIE

 L -^PRSE(452.8,PRDA)

 G QUIT

EN4 ; ENTRY FROM OPTION PRSE-C.E.

 D EN G:$G(POUT) QUIT S PRSETYP="C" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN4

 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT

 S DIE=452.8

 S DR="1///L;6///1;89;15///^S X=PRSELEN;7;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;7.5;7.6;77;2;10;9;3//GOVERNMENT FUNDED;11//YES;5"

 S DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 D ^DIE

 L -^PRSE(452.8,PRDA)

 G QUIT

EN5 ; ENTRY FROM OPTION PRSE-W.I.

 D EN G:$G(POUT) QUIT S PRSETYP="W" D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN5

 N PRDALOC

 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT

 S PRDALOC=$G(PRDA)

 S DIE=452.8,DR="1///L;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;11///NO",DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;@1;3.1" D ^DIE

 D ATTEND^PRSEED0

 L -^PRSE(452.8,PRDALOC)

 G QUIT

ATTEND K POUT W !!,"Do you want to credit students for attending this class" S %=1 D YN^DICN I %=0 W $C(7),!!,"Answer YES or NO." G ATTEND

 I %=1 S PRDA(2)=DA,PRSEY=^PRSE(452.8,PRDA(2),0) N DP,DIE,DA,DQ,DI,DR,DL W ! S PRSEPROG=$P($G(^PRSE(452.1,+PRSEMI,0)),U),PRSEPROG(1)=$G(^PRSE(452.1,+PRSEMI,0)) D DATE^PRSEED8

 Q

EN6 ; ENTRY FROM OPTION PRSE-O.I.

 D EN G:$G(POUT) QUIT S PRSETYP="O",PRSESER=+$G(^VA(200,DUZ,5)) I PRSESER="" D MSG3^PRSEMSG G QUIT

 D SELSVC G:$D(POUT) QUIT D EN8^PRSEUTL2 G:$D(DTOUT)!($D(DUOUT))!(U[X) QUIT G:$D(POUT) EN6

 S (PRDA,DA)=+Y L +^PRSE(452.8,PRDA):0 I '$T D MSG14^PRSEMSG G QUIT

 S DIE=452.8

 S DR="1///L;6///1;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;2;10;9;3//GOVERNMENT FUNDED;11//NO;5",DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 D ^DIE K DIE,DR

 L -^PRSE(452.8,PRDA)

 G QUIT

SELSVC ; DETERMINE SERVICE

 D EN2^PRSEUTL3($G(DUZ)) I PRSESER="",'(DUZ(0)["@") D MSG3^PRSEMSG S POUT=1

 Q

LOC ; LOCATION SELECTION

 I X=U!($G(POUT)) S Y=0 Q

 S PRSEDEF="",PRSEDEF=$P($G(^PRSE(452.8,DA(1),3,DA,0)),U,2)

 S PRSENAM=$P($G(^PRSE(452.8,DA(1),3,DA,0)),U,4) I '(PRSENAM=""),$D(^VA(200,"B",PRSENAM)),$G(PRSEDEF)="" S PRSEDEF=$P(^PRSE(452.7,1,0),U,2)

 I PRSEDEF="",'($D(VA(200,"B",PRSENAM))),'(PRSENAM=""),$D(^PRSE(452.2,"B",PRSENAM)) D

 .  S PRSEDA=$O(^PRSE(452.2,"B",PRSENAM,0)) I $D(^PRSE(452.2,+PRSEDA,0)) S PRSEZ=^(0) S:'($P(PRSEZ,U,3)="") PRSEDEF=$P(PRSEZ,U,3)_","_$S($D(^DIC(5,+$P(PRSEZ,U,4),0)):$P(^(0),U,2),1:"")

 .  Q

ASK W !?2,"LOCATION OF PRESENTATION: "_$S('(PRSEDEF=""):PRSEDEF_"//",1:"") R X:DTIME I '$T!(X="^") S Y=0 Q

 I X="@" S $P(^PRSE(452.8,DA(1),3,DA,0),U,2)="" G LOC

 I X="",'(PRSEDEF="") S X=PRSEDEF

 I $S(X["?":1,($L(X)<3):1,($L(X)>30):1,1:0) W !!,$C(7),?3,"Answer must be 3-30 characters in length.",!,?2,"This field contains the location where the Program/Class is to be held.",! G ASK

 S PRSELOC=$S('(X=""):X,X=""&'(PRSEDEF=""):PRSEDEF,1:PRSELOC)

 K PRSENAM

 Q

EN ;

 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG S POUT=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSEED0   4630     printed  Feb 18, 2025@23:52:53                                                                                                                                                                                                     Page 2

PRSEED0   ;HISC/MD/JH-SITE FILE ENTER EDIT DRIVER ;9/10/99

 +1       ;;4.0;PAID;**2,20,44,50**;Sep 21, 1995

EN2       ; ENTRY FROM OPTION PRSE-MIEX

 +1        DO EN

           if $GET(POUT)

               GOTO QUIT

           SET PRSETYP="M"

           DO SELSVC

           if $DATA(POUT)

               GOTO QUIT

           DO EN8^PRSEUTL2

           if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)

               GOTO QUIT

           if $DATA(POUT)

               GOTO EN2

 +2        SET (PRDA,DA)=+Y

           LOCK +^PRSE(452.8,+PRDA):0

           IF '$TEST

               DO MSG14^PRSEMSG

               GOTO QUIT

 +3        KILL DR

           SET DIE=452.8

 +4        SET DR="1///L;6///1;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;2;2.5;10;9;3//GOVERNMENT FUNDED;11//YES;5;D EN1^PRSEUTL4"

 +5        SET DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 +6        DO ^DIE

 +7        LOCK -^PRSE(452.8,+PRDA)

QUIT       KILL PRSENAM,DIK,PRSETYP,PRSESER,DIC,DIE,DIR,DR,DTOUT,DUOUT,DA,POUT,DO,DD,%,D,D0,DIK,PRSEDA,PRSEFILE,PRSECLS,PRSEGLO,PRSEGOV,PRSEPROG,PRSEX,PRSEY,W,X,Y,Z,%XD1,DC,DDH,DIEL,DIPE,DIZ,DK,DL,DM,DP,DW,PRSEDAT,PRSEMI,PRSEDEF,PRSELOC,PRSELEN

           DO ^%ZISC

 +1        KILL PSPC,PRSEDONE,PRSESTRT,PRSECORD,PRDA,ZZ,PRSENEW

 +2        QUIT 

EN3       ; ENTRY FROM OPTION PRSE-M.I.

 +1        DO EN

           if $GET(POUT)

               GOTO QUIT

           SET PRSETYP="M"

           DO SELSVC

           if $DATA(POUT)

               GOTO QUIT

           DO EN8^PRSEUTL2

           if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)

               GOTO QUIT

           if $DATA(POUT)

               GOTO EN3

 +2        SET (PRDA,DA)=+Y

           LOCK +^PRSE(452.8,PRDA):0

           IF '$TEST

               DO MSG14^PRSEMSG

               GOTO QUIT

 +3        SET DIE=452.8

           SET DR="1///L;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;11///NO;D EN1^PRSEUTL4"

           SET DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 +4        DO ^DIE

 +5        LOCK -^PRSE(452.8,PRDA)

 +6        GOTO QUIT

EN4       ; ENTRY FROM OPTION PRSE-C.E.

 +1        DO EN

           if $GET(POUT)

               GOTO QUIT

           SET PRSETYP="C"

           DO SELSVC

           if $DATA(POUT)

               GOTO QUIT

           DO EN8^PRSEUTL2

           if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)

               GOTO QUIT

           if $DATA(POUT)

               GOTO EN4

 +2        SET (PRDA,DA)=+Y

           LOCK +^PRSE(452.8,PRDA):0

           IF '$TEST

               DO MSG14^PRSEMSG

               GOTO QUIT

 +3        SET DIE=452.8

 +4        SET DR="1///L;6///1;89;15///^S X=PRSELEN;7;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;7.5;7.6;77;2;10;9;3//GOVERNMENT FUNDED;11//YES;5"

 +5        SET DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 +6        DO ^DIE

 +7        LOCK -^PRSE(452.8,PRDA)

 +8        GOTO QUIT

EN5       ; ENTRY FROM OPTION PRSE-W.I.

 +1        DO EN

           if $GET(POUT)

               GOTO QUIT

           SET PRSETYP="W"

           DO SELSVC

           if $DATA(POUT)

               GOTO QUIT

           DO EN8^PRSEUTL2

           if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)

               GOTO QUIT

           if $DATA(POUT)

               GOTO EN5

 +2        NEW PRDALOC

 +3        SET (PRDA,DA)=+Y

           LOCK +^PRSE(452.8,PRDA):0

           IF '$TEST

               DO MSG14^PRSEMSG

               GOTO QUIT

 +4        SET PRDALOC=$GET(PRDA)

 +5        SET DIE=452.8

           SET DR="1///L;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;11///NO"

           SET DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;@1;3.1"

           DO ^DIE

 +6        DO ATTEND^PRSEED0

 +7        LOCK -^PRSE(452.8,PRDALOC)

 +8        GOTO QUIT

ATTEND     KILL POUT

           WRITE !!,"Do you want to credit students for attending this class"

           SET %=1

           DO YN^DICN

           IF %=0

               WRITE $CHAR(7),!!,"Answer YES or NO."

               GOTO ATTEND

 +1        IF %=1

               SET PRDA(2)=DA

               SET PRSEY=^PRSE(452.8,PRDA(2),0)

               NEW DP,DIE,DA,DQ,DI,DR,DL

               WRITE !

               SET PRSEPROG=$PIECE($GET(^PRSE(452.1,+PRSEMI,0)),U)

               SET PRSEPROG(1)=$GET(^PRSE(452.1,+PRSEMI,0))

               DO DATE^PRSEED8

 +2        QUIT 

EN6       ; ENTRY FROM OPTION PRSE-O.I.

 +1        DO EN

           if $GET(POUT)

               GOTO QUIT

           SET PRSETYP="O"

           SET PRSESER=+$GET(^VA(200,DUZ,5))

           IF PRSESER=""

               DO MSG3^PRSEMSG

               GOTO QUIT

 +2        DO SELSVC

           if $DATA(POUT)

               GOTO QUIT

           DO EN8^PRSEUTL2

           if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)

               GOTO QUIT

           if $DATA(POUT)

               GOTO EN6

 +3        SET (PRDA,DA)=+Y

           LOCK +^PRSE(452.8,PRDA):0

           IF '$TEST

               DO MSG14^PRSEMSG

               GOTO QUIT

 +4        SET DIE=452.8

 +5        SET DR="1///L;6///1;89;15///^S X=PRSELEN;D EN1^PRSEUTL3;7.1//^S X=PRSELEN;7.2//^S X=0;77;2;10;9;3//GOVERNMENT FUNDED;11//NO;5"

           SET DR(2,452.889)=".01;2;D EN2^PRSEUTL1;S:PRSENAM="""" Y=""@1"";3////^S X=PRSENAM;D LOC^PRSEED0;1///^S X=PRSELOC;@1;3.1"

 +6        DO ^DIE

           KILL DIE,DR

 +7        LOCK -^PRSE(452.8,PRDA)

 +8        GOTO QUIT

SELSVC    ; DETERMINE SERVICE

 +1        DO EN2^PRSEUTL3($GET(DUZ))

           IF PRSESER=""

               IF '(DUZ(0)["@")

                   DO MSG3^PRSEMSG

                   SET POUT=1

 +2        QUIT 

LOC       ; LOCATION SELECTION

 +1        IF X=U!($GET(POUT))

               SET Y=0

               QUIT 

 +2        SET PRSEDEF=""

           SET PRSEDEF=$PIECE($GET(^PRSE(452.8,DA(1),3,DA,0)),U,2)

 +3        SET PRSENAM=$PIECE($GET(^PRSE(452.8,DA(1),3,DA,0)),U,4)

           IF '(PRSENAM="")

               IF $DATA(^VA(200,"B",PRSENAM))

                   IF $GET(PRSEDEF)=""

                       SET PRSEDEF=$PIECE(^PRSE(452.7,1,0),U,2)

 +4        IF PRSEDEF=""

               IF '($DATA(VA(200,"B",PRSENAM)))

                   IF '(PRSENAM="")

                       IF $DATA(^PRSE(452.2,"B",PRSENAM))

                           Begin DoDot:1

 +5                            SET PRSEDA=$ORDER(^PRSE(452.2,"B",PRSENAM,0))

                               IF $DATA(^PRSE(452.2,+PRSEDA,0))

                                   SET PRSEZ=^(0)

                                   if '($PIECE(PRSEZ,U,3)="")

                                       SET PRSEDEF=$PIECE(PRSEZ,U,3)_","_$SELECT($DATA(^DIC(5,+$PIECE(PRSEZ,U,4),0)):$PIECE(^(0),U,2),1:"")

 +6                            QUIT 

                           End DoDot:1

ASK        WRITE !?2,"LOCATION OF PRESENTATION: "_$SELECT('(PRSEDEF=""):PRSEDEF_"//",1:"")

           READ X:DTIME

           IF '$TEST!(X="^")

               SET Y=0

               QUIT 

 +1        IF X="@"

               SET $PIECE(^PRSE(452.8,DA(1),3,DA,0),U,2)=""

               GOTO LOC

 +2        IF X=""

               IF '(PRSEDEF="")

                   SET X=PRSEDEF

 +3        IF $SELECT(X["?":1,($LENGTH(X)<3):1,($LENGTH(X)>30):1,1:0)

               WRITE !!,$CHAR(7),?3,"Answer must be 3-30 characters in length.",!,?2,"This field contains the location where the Program/Class is to be held.",!

               GOTO ASK

 +4        SET PRSELOC=$SELECT('(X=""):X,X=""&'(PRSEDEF=""):PRSEDEF,1:PRSELOC)

 +5        KILL PRSENAM

 +6        QUIT 

EN        ;

 +1        SET X=$GET(^PRSE(452.7,1,"OFF"))

           IF X=""!(X=1)

               DO MSG6^PRSEMSG

               SET POUT=1

 +2        QUIT