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 ---[H[J[2J[HPRSEED0 4630 printed Dec 13, 2024@02:26:22 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
