source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEUTL6.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PRSEUTL6 ;HISC/MD-SERVICE SELECTION FROM FILE 454.1 ;2/22/94
2 ;;4.0;PAID;**3,46**;Sep 21, 1995
3EN1 ; SELECT SERVICE FROM OPTION PRSE-M.I.
4 N DA,Y,X I $G(^PRSP(454.1,0))="" W !,$C(7),"COST CENTER ORGANIZATION FILE IS NOT RESIDENT CANNOT CONTINUE!!"
5 K POUT,^TMP("PRSESEV",$J)
6 D DISP I $O(^TMP("PRSESRV",$J,0))'>0 S POUT=1
7QUIT K PRSETAB,PRSE,PRSEAQ,PRSEND,DIC,PURP,PSVC,DLAYGO,I,PRSEMAX,NCTR,PDA,PRMI,PRSECLA,PRSECNT,PRSEI,PRSEMI,PRSVC,PRSW,PRX
8 Q
9DISP ;
10 K PRSETAB,PSVC S NCTR=1,PRSVC="",PRSEMAX=0
11 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
12 . I '($P($G(^PRSP(454.1,+DA,0)),U)="MISCELLANEOUS") D
13 . . S PRSEMAX=PRSEMAX+1,PSVC(PRSEMAX)=DA_"^"_PRSVC
14 . . Q
15 . Q
16 S PRSEMAX=PRSEMAX+1,PSVC(PRSEMAX)="ALL^ALL"
17 S PRSESTRT=1,(POUT,PRSEDONE)=0
18 K ^TMP("PRSEGRP",$J) F D DSP I $G(PRSEDONE)!$G(POUT) Q
19 Q
20DSP ;
21 W @IOF S PRSEAQ=$Y
22 F PRSE=PRSESTRT:2:PRSEMAX S PRSEI=PRSE D I $Y>(IOSL+PRSEAQ-5),PRSE'=PRSEMAX S PRSESTRT=PRSE+2 Q
23 . Q:$D(PSVC(PRSEI))[0
24 . 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)
25 . Q
26 S PRSEDONE=(PRSE=PRSEMAX)!(PRSE+1=PRSEMAX)
27 I 'PRSEDONE W !,"<<More>>"
28ASK ;
29 W !,"Select SERVICE(S): " R PRX:DTIME
30 S:'$T PRX="^" I "^"[PRX S:$E(PRX)="^" POUT=1 Q
31 I PRX=PRSEMAX!($$UP^XLFSTR(PRX)="ALL") S PRX="1"_$S(PRSEMAX>2:"-"_(PRSEMAX-1),1:"")
32 D VALENT^PRSEED7 I (PRX["?"!(PRSEBAD)) G DSP:PRX?2."?",ASK
33 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))=""
34 Q
35DICS(DUZ,Y,PRSEPROG) ; SCREEN FOR STUDENT LOOKUP IN REGISTRATION/ATTENDANCE
36 N PRSX S PRSX=0
37 I $$EN12^PRSEUTL3($G(Y)) D
38 . I DUZ(0)["@"!(+$$EN4^PRSEUTL3($G(DUZ))!('$$EN3^PRSEUTL3($G(Y))!(+$$EN3^PRSEUTL3($G(Y))=PRSESER))) S PRSX=1 Q
39 . I +$$EN3^PRSEUTL3($G(DUZ))=$P(PRSEPROG(1),U,8),+$$EN6^PRSEUTL3($G(DUZ)) S PRSX=1
40 . Q
41 Q PRSX
Note: See TracBrowser for help on using the repository browser.