| [613] | 1 | PRCNCMRP ;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
|
|---|
| 4 | EN ;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
|
|---|
| 18 | DOWN ; 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
|
|---|
| 26 | XREF ; 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
|
|---|
| 31 | XR 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
|
|---|
| 38 | PRIMAX ; 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
|
|---|
| 48 | DPRI ; 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
|
|---|
| 57 | GETPR 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
|
|---|
| 61 | SETDA 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
|
|---|
| 64 | GETDA S OLDA="" F S OLDA=$O(^PRCN(413,"P",PSER,NXPR,OLDA)) Q:OLDA="" S:OLDA'=DA OTHDA=OLDA
|
|---|
| 65 | Q
|
|---|
