66 lines
2.4 KiB
Mathematica
66 lines
2.4 KiB
Mathematica
PRCNCMRP ;SSI/SEB,ALA-CMR Official Priority Handler ;[ 01/23/97 4:52 PM ]
|
|
;;1.0;Equipment/Turn-In Request;**2,5**;Sep 13, 1996
|
|
Q
|
|
EN ;Check on entered priority
|
|
K:+X'=X!(X>999)!(X<1)!(X?.E1"."1N.N) X
|
|
I $G(X)="" Q
|
|
; Check if priority X already exists for this service
|
|
D:'$D(PSER) PRIMAX
|
|
S PRCNX=$P($G(^PRCN(413,DA,2)),U,18)
|
|
I PRCNX'="" K ^PRCN(413,"P",PSER,PRCNX,DA)
|
|
K PRCNX
|
|
Q:'$D(^PRCN(413,"P",PSER,X))
|
|
Q:$D(^PRCN(413,"P",PSER,X,DA))
|
|
NEW I
|
|
I $D(^PRCN(413,"P",PSER,X)) S START=X D DOWN S DA=ORGDA
|
|
K START,ORGDA
|
|
Q
|
|
DOWN ; Insert this transaction & shift others one priority #
|
|
W !!,"Reprioritizing this CMR's requests... Hold on..."
|
|
D PRIMAX S LPRI=LPRI+1 S ORGDA=DA NEW DA S DA=ORGDA
|
|
S ^PRCN(413,"P",PSER,START,ORGDA)=""
|
|
S NXPR=START D GETDA
|
|
I OTHDA'="",OTHDA'=DA S NXPR=START D GETPR
|
|
K OTHDA,DA,NXPR,START,OLDA
|
|
Q
|
|
XREF ; Special MUMPS cross-reference for priorities
|
|
S PRCNX=$G(X)
|
|
S X=$P($G(^PRCN(413,DA,2)),U,18)
|
|
D:'$D(PSER) PRIMAX
|
|
I X="",$G(PRCNX)'="" K ^PRCN(413,"P",PSER,PRCNX,DA),PRCNX Q
|
|
XR S STAT=$P(^PRCN(413,DA,0),U,7),SK=0
|
|
I STAT<5!(STAT>10) S SK=1
|
|
I STAT=31!(STAT=45)!(STAT=3)!(STAT=27) S SK=0
|
|
I SK=0 S ^PRCN(413,"P",PSER,X,DA)=""
|
|
I SK=1 K ^PRCN(413,"P",PSER,X,DA)
|
|
K PSER,SK,STAT
|
|
Q
|
|
PRIMAX ; Calculate lowest priority. Used in input template, etc.
|
|
; Returns OLDPRI, PSER, SERV, LPRI, and PRIMAX.
|
|
S OLDPRI=$P($G(^PRCN(413,DA,2)),U,18),PSER=$P($G(^PRCN(413,DA,0)),U,3)
|
|
S (II,PRIMAX)=0 S:PSER'="" SERV=$P(^DIC(49,PSER,0),U)
|
|
I PSER'="" F S II=$O(^PRCN(413,"P",PSER,II)) Q:II="" S PRIMAX=PRIMAX+1,LPRI=II
|
|
I +OLDPRI'=0 S PRIMAX=+OLDPRI Q
|
|
I +OLDPRI=0,$G(LPRI)="" S (PRIMAX,LPRI)=0 Q
|
|
I +OLDPRI=0,$G(LPRI)'="" S PRIMAX=LPRI
|
|
K II
|
|
Q
|
|
DPRI ; Display priorities. Called as special help for priority fld.
|
|
I $G(SERV)=""!($G(PSER)="") D PRIMAX
|
|
W !!,"Priority list for ",SERV,":"
|
|
S PRCNI=0 F S PRCNI=$O(^PRCN(413,"P",PSER,PRCNI)) Q:'+PRCNI D
|
|
. S J=$O(^PRCN(413,"P",PSER,PRCNI,""))
|
|
. I $G(^PRCN(413,J,0))="" K ^PRCN(413,"P",PSER,PRCNI,J) Q
|
|
. W !,PRCNI,?8,$P(^PRCN(413,J,0),U),?25,$P(^(0),U,18)
|
|
K PRCNI,J
|
|
Q
|
|
GETPR S NXPR=$O(^PRCN(413,"P",PSER,NXPR))
|
|
I NXPR'=(START+1) S NXPR=START+1 D SETDA Q
|
|
I NXPR=(START+1) D SETDA S START=NXPR,DA=OTHDA D GETDA G GETPR
|
|
Q
|
|
SETDA S $P(^PRCN(413,OTHDA,2),U,18)=NXPR,^PRCN(413,"P",PSER,NXPR,OTHDA)=""
|
|
K ^PRCN(413,"P",PSER,START,OTHDA)
|
|
Q
|
|
GETDA S OLDA="" F S OLDA=$O(^PRCN(413,"P",PSER,NXPR,OLDA)) Q:OLDA="" S:OLDA'=DA OTHDA=OLDA
|
|
Q
|