ORKMGR ; SLC/AEB,CLA - Manager Options - Order Checking Parameters ;9/22/97
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,105,401**;Dec 17, 1997;Build 11
;
;References to ^XPAR supported by IA #2263
;Direct read of 8989.51 "B" index supported by IA #2685
;References to ^DIR supported by IA #10026
;Fileman read of File 200 Field .01 field supported by IA #10060
;Fileman read of File 44 Field .01 field supported by IA #10040
;Fileman read of File 49 Field .01 supported by IA #10093
;Fileman read of File 4 Field .01 supported by IA #10090
;Fileman read of File 4.2 Field .01 supported by IA #1966
;Fileman read of File 9.4 Field .01 supported by IA #10048
;Reference to $$GET1^DIQ() supported by IA #2056
;
PFLAG ;
N ORKT,PAR,PIEN
S ORKT="Enable/Disable an Order Check",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK PROCESSING FLAG",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
CLINDL ;
N ORKT,PAR,PIEN
S ORKT="Set Clinical Danger Level for an Order Check",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK CLINICAL DANGER LEVEL",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
CTLIMH ;
N ORKT,PAR,PIEN
S ORKT="CT Scanner Height Limit",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK CT LIMIT HT",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
CTLIMW ;
N ORKT,PAR,PIEN
S ORKT="CAT Scanner Weight Limit",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK CT LIMIT WT",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
MRLIMH ;
N ORKT,PAR,PIEN
S ORKT="MRI Scanner Height Limit",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK MRI LIMIT HT",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
MRLIMW ;
N ORKT,PAR,PIEN
S ORKT="MRI Scanner Weight Limit",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK MRI LIMIT WT",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
DUPOR ;
N ORKT,PAR,PIEN
S ORKT="Orderable Item Duplicate Order Range",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK DUP ORDER RANGE OI",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
DUPLR ;
N ORKT,PAR,PIEN
S ORKT="Lab Duplicate Order Range",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK DUP ORDER RANGE LAB",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
DUPRA ;
N ORKT,PAR,PIEN
S ORKT="Imaging Duplicate Order Range",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK DUP ORDER RANGE RADIOLOGY",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
SYSEN ;
N ORKT,PAR,PIEN
S ORKT="Enable or Disable Order Checking System",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK SYSTEM ENABLE/DISABLE",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
DEBUG ;
N ORKT,PAR,PIEN
S ORKT="Enable or Disable Logging Debug Messages",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK DEBUG ENABLE/DISABLE",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
POLYRX ;
N ORKT,PAR,PIEN
S ORKT="Set Number of Meds for Polypharmacy",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK POLYPHARMACY",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
GLUCREAT ;
N ORKT,PAR,PIEN
S ORKT="Set Creatinine Search Range for Glucophage-Lab Results Order Check",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK GLUCOPHAGE CREATININE",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
EDITUSER ;
N ORKT,PAR,PIEN
S ORKT="Set One or More Order Checks to be Uneditable By End Users",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK EDITABLE BY USER",PIEN)) Q:PIEN=""
;P.401 added check for existing disabled parameters
N OLDLIST,NEWLIST,ERR,ORPFIEN
S ORPFIEN=0 S ORPFIEN=$O(^XTV(8989.51,"B","ORK PROCESSING FLAG",ORPFIEN))
D ENVAL^XPAR(.OLDLIST,PIEN,,.ERR)
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
I '$G(ERR) D ENVAL^XPAR(.NEWLIST,PIEN,,.ERR)
Q:$G(ERR)
N ORENT S ORENT="" F S ORENT=$O(NEWLIST(ORENT)) Q:'ORENT N ORINST S ORINST="" F S ORINST=$O(NEWLIST(ORENT,ORINST)) Q:'ORINST I ('$D(OLDLIST(ORENT,ORINST))!($G(OLDLIST(ORENT,ORINST))=1))&(($G(NEWLIST(ORENT,ORINST))=0)) D
.N PFLIST D ENVAL^XPAR(.PFLIST,ORPFIEN,,.ERR) Q:$G(ERR)
.N PFENT S PFENT="" F S PFENT=$O(PFLIST(PFENT)) Q:'PFENT N PFINST S PFINST="" F S PFINST=$O(PFLIST(PFENT,PFINST)) Q:'PFINST I PFINST=ORINST D
..D CHG^XPAR(PFENT,ORPFIEN,"`"_PFINST,"E",.ERR)
Q
;
CMCREAT ;
N ORKT,PAR,PIEN
S ORKT="Set Creatinine Search Range for Biochem Abnormality for Contrast Media Order Chk",PIEN=0
S PIEN=$O(^XTV(8989.51,"B","ORK CONTRAST MEDIA CREATININE",PIEN)) Q:PIEN=""
S PAR=PIEN
D TITLE(ORKT) D PROC(PAR)
Q
;
TITLE(ORKT) ;
; Center and write title - Parameter to be set
S IOP=0 D ^%ZIS K IOP W @IOF
W !,?(80-$L(ORKT)-1/2),ORKT
Q
PROC(PAR) ; Process Parameter Settings
D EDITPAR^XPAREDIT(PAR)
Q
USRCHKS ; List order checks a user could receive
N ORKUSR
; Get user DUZ number
K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
S ORKUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
D USRCHKS^ORKUTL(ORKUSR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKMGR 5012 printed Oct 16, 2024@18:31:42 Page 2
ORKMGR ; SLC/AEB,CLA - Manager Options - Order Checking Parameters ;9/22/97
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,105,401**;Dec 17, 1997;Build 11
+2 ;
+3 ;References to ^XPAR supported by IA #2263
+4 ;Direct read of 8989.51 "B" index supported by IA #2685
+5 ;References to ^DIR supported by IA #10026
+6 ;Fileman read of File 200 Field .01 field supported by IA #10060
+7 ;Fileman read of File 44 Field .01 field supported by IA #10040
+8 ;Fileman read of File 49 Field .01 supported by IA #10093
+9 ;Fileman read of File 4 Field .01 supported by IA #10090
+10 ;Fileman read of File 4.2 Field .01 supported by IA #1966
+11 ;Fileman read of File 9.4 Field .01 supported by IA #10048
+12 ;Reference to $$GET1^DIQ() supported by IA #2056
+13 ;
PFLAG ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Enable/Disable an Order Check"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK PROCESSING FLAG",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
CLINDL ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Set Clinical Danger Level for an Order Check"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK CLINICAL DANGER LEVEL",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
CTLIMH ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="CT Scanner Height Limit"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK CT LIMIT HT",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
CTLIMW ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="CAT Scanner Weight Limit"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK CT LIMIT WT",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
MRLIMH ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="MRI Scanner Height Limit"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK MRI LIMIT HT",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
MRLIMW ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="MRI Scanner Weight Limit"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK MRI LIMIT WT",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
DUPOR ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Orderable Item Duplicate Order Range"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK DUP ORDER RANGE OI",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
DUPLR ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Lab Duplicate Order Range"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK DUP ORDER RANGE LAB",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
DUPRA ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Imaging Duplicate Order Range"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK DUP ORDER RANGE RADIOLOGY",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
SYSEN ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Enable or Disable Order Checking System"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK SYSTEM ENABLE/DISABLE",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
DEBUG ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Enable or Disable Logging Debug Messages"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK DEBUG ENABLE/DISABLE",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
POLYRX ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Set Number of Meds for Polypharmacy"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK POLYPHARMACY",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
GLUCREAT ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Set Creatinine Search Range for Glucophage-Lab Results Order Check"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK GLUCOPHAGE CREATININE",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
EDITUSER ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Set One or More Order Checks to be Uneditable By End Users"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK EDITABLE BY USER",PIEN))
if PIEN=""
QUIT
+4 ;P.401 added check for existing disabled parameters
+5 NEW OLDLIST,NEWLIST,ERR,ORPFIEN
+6 SET ORPFIEN=0
SET ORPFIEN=$ORDER(^XTV(8989.51,"B","ORK PROCESSING FLAG",ORPFIEN))
+7 DO ENVAL^XPAR(.OLDLIST,PIEN,,.ERR)
+8 SET PAR=PIEN
+9 DO TITLE(ORKT)
DO PROC(PAR)
+10 IF '$GET(ERR)
DO ENVAL^XPAR(.NEWLIST,PIEN,,.ERR)
+11 if $GET(ERR)
QUIT
+12 NEW ORENT
SET ORENT=""
FOR
SET ORENT=$ORDER(NEWLIST(ORENT))
if 'ORENT
QUIT
NEW ORINST
SET ORINST=""
FOR
SET ORINST=$ORDER(NEWLIST(ORENT,ORINST))
if 'ORINST
QUIT
IF ('$DATA(OLDLIST(ORENT,ORINST))!($GET(OLDLIST(ORENT,ORINST))=1))&(($GET(NEWLIST(ORENT,ORINST))=0))
Begin DoDot:1
+13 NEW PFLIST
DO ENVAL^XPAR(.PFLIST,ORPFIEN,,.ERR)
if $GET(ERR)
QUIT
+14 NEW PFENT
SET PFENT=""
FOR
SET PFENT=$ORDER(PFLIST(PFENT))
if 'PFENT
QUIT
NEW PFINST
SET PFINST=""
FOR
SET PFINST=$ORDER(PFLIST(PFENT,PFINST))
if 'PFINST
QUIT
IF PFINST=ORINST
Begin DoDot:2
+15 DO CHG^XPAR(PFENT,ORPFIEN,"`"_PFINST,"E",.ERR)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
CMCREAT ;
+1 NEW ORKT,PAR,PIEN
+2 SET ORKT="Set Creatinine Search Range for Biochem Abnormality for Contrast Media Order Chk"
SET PIEN=0
+3 SET PIEN=$ORDER(^XTV(8989.51,"B","ORK CONTRAST MEDIA CREATININE",PIEN))
if PIEN=""
QUIT
+4 SET PAR=PIEN
+5 DO TITLE(ORKT)
DO PROC(PAR)
+6 QUIT
+7 ;
TITLE(ORKT) ;
+1 ; Center and write title - Parameter to be set
+2 SET IOP=0
DO ^%ZIS
KILL IOP
WRITE @IOF
+3 WRITE !,?(80-$LENGTH(ORKT)-1/2),ORKT
+4 QUIT
PROC(PAR) ; Process Parameter Settings
+1 DO EDITPAR^XPAREDIT(PAR)
+2 QUIT
USRCHKS ; List order checks a user could receive
+1 NEW ORKUSR
+2 ; Get user DUZ number
+3 KILL DIC,Y
SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="Enter user's name: "
SET DIC("B")=DUZ
DO ^DIC
if Y<1
QUIT
+4 SET ORKUSR=$SELECT(Y'<1:$PIECE(Y,"^"),1:DUZ)
KILL DIC,Y,DUOUT,DTOUT
+5 DO USRCHKS^ORKUTL(ORKUSR)
+6 QUIT
