source: FOIAVistA/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNCMRP.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1PRCNCMRP ;SSI/SEB,ALA-CMR Official Priority Handler ;[ 01/23/97 4:52 PM ]
2 ;;1.0;Equipment/Turn-In Request;**2,5**;Sep 13, 1996
3 Q
4EN ;Check on entered priority
5 K:+X'=X!(X>999)!(X<1)!(X?.E1"."1N.N) X
6 I $G(X)="" Q
7 ; Check if priority X already exists for this service
8 D:'$D(PSER) PRIMAX
9 S PRCNX=$P($G(^PRCN(413,DA,2)),U,18)
10 I PRCNX'="" K ^PRCN(413,"P",PSER,PRCNX,DA)
11 K PRCNX
12 Q:'$D(^PRCN(413,"P",PSER,X))
13 Q:$D(^PRCN(413,"P",PSER,X,DA))
14 NEW I
15 I $D(^PRCN(413,"P",PSER,X)) S START=X D DOWN S DA=ORGDA
16 K START,ORGDA
17 Q
18DOWN ; Insert this transaction & shift others one priority #
19 W !!,"Reprioritizing this CMR's requests... Hold on..."
20 D PRIMAX S LPRI=LPRI+1 S ORGDA=DA NEW DA S DA=ORGDA
21 S ^PRCN(413,"P",PSER,START,ORGDA)=""
22 S NXPR=START D GETDA
23 I OTHDA'="",OTHDA'=DA S NXPR=START D GETPR
24 K OTHDA,DA,NXPR,START,OLDA
25 Q
26XREF ; Special MUMPS cross-reference for priorities
27 S PRCNX=$G(X)
28 S X=$P($G(^PRCN(413,DA,2)),U,18)
29 D:'$D(PSER) PRIMAX
30 I X="",$G(PRCNX)'="" K ^PRCN(413,"P",PSER,PRCNX,DA),PRCNX Q
31XR S STAT=$P(^PRCN(413,DA,0),U,7),SK=0
32 I STAT<5!(STAT>10) S SK=1
33 I STAT=31!(STAT=45)!(STAT=3)!(STAT=27) S SK=0
34 I SK=0 S ^PRCN(413,"P",PSER,X,DA)=""
35 I SK=1 K ^PRCN(413,"P",PSER,X,DA)
36 K PSER,SK,STAT
37 Q
38PRIMAX ; Calculate lowest priority. Used in input template, etc.
39 ; Returns OLDPRI, PSER, SERV, LPRI, and PRIMAX.
40 S OLDPRI=$P($G(^PRCN(413,DA,2)),U,18),PSER=$P($G(^PRCN(413,DA,0)),U,3)
41 S (II,PRIMAX)=0 S:PSER'="" SERV=$P(^DIC(49,PSER,0),U)
42 I PSER'="" F S II=$O(^PRCN(413,"P",PSER,II)) Q:II="" S PRIMAX=PRIMAX+1,LPRI=II
43 I +OLDPRI'=0 S PRIMAX=+OLDPRI Q
44 I +OLDPRI=0,$G(LPRI)="" S (PRIMAX,LPRI)=0 Q
45 I +OLDPRI=0,$G(LPRI)'="" S PRIMAX=LPRI
46 K II
47 Q
48DPRI ; Display priorities. Called as special help for priority fld.
49 I $G(SERV)=""!($G(PSER)="") D PRIMAX
50 W !!,"Priority list for ",SERV,":"
51 S PRCNI=0 F S PRCNI=$O(^PRCN(413,"P",PSER,PRCNI)) Q:'+PRCNI D
52 . S J=$O(^PRCN(413,"P",PSER,PRCNI,""))
53 . I $G(^PRCN(413,J,0))="" K ^PRCN(413,"P",PSER,PRCNI,J) Q
54 . W !,PRCNI,?8,$P(^PRCN(413,J,0),U),?25,$P(^(0),U,18)
55 K PRCNI,J
56 Q
57GETPR S NXPR=$O(^PRCN(413,"P",PSER,NXPR))
58 I NXPR'=(START+1) S NXPR=START+1 D SETDA Q
59 I NXPR=(START+1) D SETDA S START=NXPR,DA=OTHDA D GETDA G GETPR
60 Q
61SETDA S $P(^PRCN(413,OTHDA,2),U,18)=NXPR,^PRCN(413,"P",PSER,NXPR,OTHDA)=""
62 K ^PRCN(413,"P",PSER,START,OTHDA)
63 Q
64GETDA S OLDA="" F S OLDA=$O(^PRCN(413,"P",PSER,NXPR,OLDA)) Q:OLDA="" S:OLDA'=DA OTHDA=OLDA
65 Q
Note: See TracBrowser for help on using the repository browser.