PRSEUTL6 ;HISC/MD-SERVICE SELECTION FROM FILE 454.1 ;2/22/94
;;4.0;PAID;**3,46**;Sep 21, 1995
EN1 ; SELECT SERVICE FROM OPTION PRSE-M.I.
N DA,Y,X I $G(^PRSP(454.1,0))="" W !,$C(7),"COST CENTER ORGANIZATION FILE IS NOT RESIDENT CANNOT CONTINUE!!"
K POUT,^TMP("PRSESEV",$J)
D DISP I $O(^TMP("PRSESRV",$J,0))'>0 S POUT=1
QUIT K PRSETAB,PRSE,PRSEAQ,PRSEND,DIC,PURP,PSVC,DLAYGO,I,PRSEMAX,NCTR,PDA,PRMI,PRSECLA,PRSECNT,PRSEI,PRSEMI,PRSVC,PRSW,PRX
Q
DISP ;
K PRSETAB,PSVC S NCTR=1,PRSVC="",PRSEMAX=0
F I=0:0 S PRSVC=$O(^PRSP(454.1,"B",PRSVC)) Q:PRSVC="" F DA=0:0 S DA=$O(^PRSP(454.1,"B",PRSVC,DA)) Q:DA'>0 D
. I '($P($G(^PRSP(454.1,+DA,0)),U)="MISCELLANEOUS") D
. . S PRSEMAX=PRSEMAX+1,PSVC(PRSEMAX)=DA_"^"_PRSVC
. . Q
. Q
S PRSEMAX=PRSEMAX+1,PSVC(PRSEMAX)="ALL^ALL"
S PRSESTRT=1,(POUT,PRSEDONE)=0
K ^TMP("PRSEGRP",$J) F D DSP I $G(PRSEDONE)!$G(POUT) Q
Q
DSP ;
W @IOF S PRSEAQ=$Y
F PRSE=PRSESTRT:2:PRSEMAX S PRSEI=PRSE D I $Y>(IOSL+PRSEAQ-5),PRSE'=PRSEMAX S PRSESTRT=PRSE+2 Q
. Q:$D(PSVC(PRSEI))[0
. S PRSEI(0)=PRSEI+1 W ! W:$G(PSVC(PRSEI))'="" ?1,$J(PRSEI,2),". ",$P($G(PSVC(PRSEI)),U,2) W:$G(PSVC(PRSEI(0)))'="" ?40,$J(PRSEI(0),2),".",$P($G(PSVC(PRSEI(0))),U,2)
. Q
S PRSEDONE=(PRSE=PRSEMAX)!(PRSE+1=PRSEMAX)
I 'PRSEDONE W !,"<<More>>"
ASK ;
W !,"Select SERVICE(S): " R PRX:DTIME
S:'$T PRX="^" I "^"[PRX S:$E(PRX)="^" POUT=1 Q
I PRX=PRSEMAX!($$UP^XLFSTR(PRX)="ALL") S PRX="1"_$S(PRSEMAX>2:"-"_(PRSEMAX-1),1:"")
D VALENT^PRSEED7 I (PRX["?"!(PRSEBAD)) G DSP:PRX?2."?",ASK
F PRSEI=1:1 S PRSECLA=$P(PRX,",",PRSEI) Q:PRSECLA="" S PRSEND=$P(PRSECLA,"-",2)_"+"_PRSECLA F PRSECNT=+PRSECLA:1:PRSEND I +$G(PSVC(PRSECNT))>0 S ^TMP("PRSESRV",$J,+PSVC(PRSECNT))=""
Q
DICS(DUZ,Y,PRSEPROG) ; SCREEN FOR STUDENT LOOKUP IN REGISTRATION/ATTENDANCE
N PRSX S PRSX=0
I $$EN12^PRSEUTL3($G(Y)) D
. I DUZ(0)["@"!(+$$EN4^PRSEUTL3($G(DUZ))!('$$EN3^PRSEUTL3($G(Y))!(+$$EN3^PRSEUTL3($G(Y))=PRSESER))) S PRSX=1 Q
. I +$$EN3^PRSEUTL3($G(DUZ))=$P(PRSEPROG(1),U,8),+$$EN6^PRSEUTL3($G(DUZ)) S PRSX=1
. Q
Q PRSX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEUTL6 2070 printed Nov 22, 2024@17:37 Page 2
PRSEUTL6 ;HISC/MD-SERVICE SELECTION FROM FILE 454.1 ;2/22/94
+1 ;;4.0;PAID;**3,46**;Sep 21, 1995
EN1 ; SELECT SERVICE FROM OPTION PRSE-M.I.
+1 NEW DA,Y,X
IF $GET(^PRSP(454.1,0))=""
WRITE !,$CHAR(7),"COST CENTER ORGANIZATION FILE IS NOT RESIDENT CANNOT CONTINUE!!"
+2 KILL POUT,^TMP("PRSESEV",$JOB)
+3 DO DISP
IF $ORDER(^TMP("PRSESRV",$JOB,0))'>0
SET POUT=1
QUIT KILL PRSETAB,PRSE,PRSEAQ,PRSEND,DIC,PURP,PSVC,DLAYGO,I,PRSEMAX,NCTR,PDA,PRMI,PRSECLA,PRSECNT,PRSEI,PRSEMI,PRSVC,PRSW,PRX
+1 QUIT
DISP ;
+1 KILL PRSETAB,PSVC
SET NCTR=1
SET PRSVC=""
SET PRSEMAX=0
+2 FOR I=0:0
SET PRSVC=$ORDER(^PRSP(454.1,"B",PRSVC))
if PRSVC=""
QUIT
FOR DA=0:0
SET DA=$ORDER(^PRSP(454.1,"B",PRSVC,DA))
if DA'>0
QUIT
Begin DoDot:1
+3 IF '($PIECE($GET(^PRSP(454.1,+DA,0)),U)="MISCELLANEOUS")
Begin DoDot:2
+4 SET PRSEMAX=PRSEMAX+1
SET PSVC(PRSEMAX)=DA_"^"_PRSVC
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 SET PRSEMAX=PRSEMAX+1
SET PSVC(PRSEMAX)="ALL^ALL"
+8 SET PRSESTRT=1
SET (POUT,PRSEDONE)=0
+9 KILL ^TMP("PRSEGRP",$JOB)
FOR
DO DSP
IF $GET(PRSEDONE)!$GET(POUT)
QUIT
+10 QUIT
DSP ;
+1 WRITE @IOF
SET PRSEAQ=$Y
+2 FOR PRSE=PRSESTRT:2:PRSEMAX
SET PRSEI=PRSE
Begin DoDot:1
+3 if $DATA(PSVC(PRSEI))[0
QUIT
+4 SET PRSEI(0)=PRSEI+1
WRITE !
if $GET(PSVC(PRSEI))'=""
WRITE ?1,$JUSTIFY(PRSEI,2),". ",$PIECE($GET(PSVC(PRSEI)),U,2)
if $GET(PSVC(PRSEI(0)))'=""
WRITE ?40,$JUSTIFY(PRSEI(0),2),".",$PIECE($GET(PSVC(PRSEI(0))),U,2)
+5 QUIT
End DoDot:1
IF $Y>(IOSL+PRSEAQ-5)
IF PRSE'=PRSEMAX
SET PRSESTRT=PRSE+2
QUIT
+6 SET PRSEDONE=(PRSE=PRSEMAX)!(PRSE+1=PRSEMAX)
+7 IF 'PRSEDONE
WRITE !,"<<More>>"
ASK ;
+1 WRITE !,"Select SERVICE(S): "
READ PRX:DTIME
+2 if '$TEST
SET PRX="^"
IF "^"[PRX
if $EXTRACT(PRX)="^"
SET POUT=1
QUIT
+3 IF PRX=PRSEMAX!($$UP^XLFSTR(PRX)="ALL")
SET PRX="1"_$SELECT(PRSEMAX>2:"-"_(PRSEMAX-1),1:"")
+4 DO VALENT^PRSEED7
IF (PRX["?"!(PRSEBAD))
if PRX?2."?"
GOTO DSP
GOTO ASK
+5 FOR PRSEI=1:1
SET PRSECLA=$PIECE(PRX,",",PRSEI)
if PRSECLA=""
QUIT
SET PRSEND=$PIECE(PRSECLA,"-",2)_"+"_PRSECLA
FOR PRSECNT=+PRSECLA:1:PRSEND
IF +$GET(PSVC(PRSECNT))>0
SET ^TMP("PRSESRV",$JOB,+PSVC(PRSECNT))=""
+6 QUIT
DICS(DUZ,Y,PRSEPROG) ; SCREEN FOR STUDENT LOOKUP IN REGISTRATION/ATTENDANCE
+1 NEW PRSX
SET PRSX=0
+2 IF $$EN12^PRSEUTL3($GET(Y))
Begin DoDot:1
+3 IF DUZ(0)["@"!(+$$EN4^PRSEUTL3($GET(DUZ))!('$$EN3^PRSEUTL3($GET(Y))!(+$$EN3^PRSEUTL3($GET(Y))=PRSESER)))
SET PRSX=1
QUIT
+4 IF +$$EN3^PRSEUTL3($GET(DUZ))=$PIECE(PRSEPROG(1),U,8)
IF +$$EN6^PRSEUTL3($GET(DUZ))
SET PRSX=1
+5 QUIT
End DoDot:1
+6 QUIT PRSX
