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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNCMRP 2472 printed Oct 16, 2024@17:55 Page 2
PRCNCMRP ;SSI/SEB,ALA-CMR Official Priority Handler ;[ 01/23/97 4:52 PM ]
+1 ;;1.0;Equipment/Turn-In Request;**2,5**;Sep 13, 1996
+2 QUIT
EN ;Check on entered priority
+1 if +X'=X!(X>999)!(X<1)!(X?.E1"."1N.N)
KILL X
+2 IF $GET(X)=""
QUIT
+3 ; Check if priority X already exists for this service
+4 if '$DATA(PSER)
DO PRIMAX
+5 SET PRCNX=$PIECE($GET(^PRCN(413,DA,2)),U,18)
+6 IF PRCNX'=""
KILL ^PRCN(413,"P",PSER,PRCNX,DA)
+7 KILL PRCNX
+8 if '$DATA(^PRCN(413,"P",PSER,X))
QUIT
+9 if $DATA(^PRCN(413,"P",PSER,X,DA))
QUIT
+10 NEW I
+11 IF $DATA(^PRCN(413,"P",PSER,X))
SET START=X
DO DOWN
SET DA=ORGDA
+12 KILL START,ORGDA
+13 QUIT
DOWN ; Insert this transaction & shift others one priority #
+1 WRITE !!,"Reprioritizing this CMR's requests... Hold on..."
+2 DO PRIMAX
SET LPRI=LPRI+1
SET ORGDA=DA
NEW DA
SET DA=ORGDA
+3 SET ^PRCN(413,"P",PSER,START,ORGDA)=""
+4 SET NXPR=START
DO GETDA
+5 IF OTHDA'=""
IF OTHDA'=DA
SET NXPR=START
DO GETPR
+6 KILL OTHDA,DA,NXPR,START,OLDA
+7 QUIT
XREF ; Special MUMPS cross-reference for priorities
+1 SET PRCNX=$GET(X)
+2 SET X=$PIECE($GET(^PRCN(413,DA,2)),U,18)
+3 if '$DATA(PSER)
DO PRIMAX
+4 IF X=""
IF $GET(PRCNX)'=""
KILL ^PRCN(413,"P",PSER,PRCNX,DA),PRCNX
QUIT
XR SET STAT=$PIECE(^PRCN(413,DA,0),U,7)
SET SK=0
+1 IF STAT<5!(STAT>10)
SET SK=1
+2 IF STAT=31!(STAT=45)!(STAT=3)!(STAT=27)
SET SK=0
+3 IF SK=0
SET ^PRCN(413,"P",PSER,X,DA)=""
+4 IF SK=1
KILL ^PRCN(413,"P",PSER,X,DA)
+5 KILL PSER,SK,STAT
+6 QUIT
PRIMAX ; Calculate lowest priority. Used in input template, etc.
+1 ; Returns OLDPRI, PSER, SERV, LPRI, and PRIMAX.
+2 SET OLDPRI=$PIECE($GET(^PRCN(413,DA,2)),U,18)
SET PSER=$PIECE($GET(^PRCN(413,DA,0)),U,3)
+3 SET (II,PRIMAX)=0
if PSER'=""
SET SERV=$PIECE(^DIC(49,PSER,0),U)
+4 IF PSER'=""
FOR
SET II=$ORDER(^PRCN(413,"P",PSER,II))
if II=""
QUIT
SET PRIMAX=PRIMAX+1
SET LPRI=II
+5 IF +OLDPRI'=0
SET PRIMAX=+OLDPRI
QUIT
+6 IF +OLDPRI=0
IF $GET(LPRI)=""
SET (PRIMAX,LPRI)=0
QUIT
+7 IF +OLDPRI=0
IF $GET(LPRI)'=""
SET PRIMAX=LPRI
+8 KILL II
+9 QUIT
DPRI ; Display priorities. Called as special help for priority fld.
+1 IF $GET(SERV)=""!($GET(PSER)="")
DO PRIMAX
+2 WRITE !!,"Priority list for ",SERV,":"
+3 SET PRCNI=0
FOR
SET PRCNI=$ORDER(^PRCN(413,"P",PSER,PRCNI))
if '+PRCNI
QUIT
Begin DoDot:1
+4 SET J=$ORDER(^PRCN(413,"P",PSER,PRCNI,""))
+5 IF $GET(^PRCN(413,J,0))=""
KILL ^PRCN(413,"P",PSER,PRCNI,J)
QUIT
+6 WRITE !,PRCNI,?8,$PIECE(^PRCN(413,J,0),U),?25,$PIECE(^(0),U,18)
End DoDot:1
+7 KILL PRCNI,J
+8 QUIT
GETPR SET NXPR=$ORDER(^PRCN(413,"P",PSER,NXPR))
+1 IF NXPR'=(START+1)
SET NXPR=START+1
DO SETDA
QUIT
+2 IF NXPR=(START+1)
DO SETDA
SET START=NXPR
SET DA=OTHDA
DO GETDA
GOTO GETPR
+3 QUIT
SETDA SET $PIECE(^PRCN(413,OTHDA,2),U,18)=NXPR
SET ^PRCN(413,"P",PSER,NXPR,OTHDA)=""
+1 KILL ^PRCN(413,"P",PSER,START,OTHDA)
+2 QUIT
GETDA SET OLDA=""
FOR
SET OLDA=$ORDER(^PRCN(413,"P",PSER,NXPR,OLDA))
if OLDA=""
QUIT
if OLDA'=DA
SET OTHDA=OLDA
+1 QUIT
