ORKMGR.m

ORKMGR ; SLC/AEB,CLA - Manager Options - Order Checking Parameters ;9/22/97

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,105**;Dec 17, 1997

 ;

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=""

 S PAR=PIEN

 D TITLE(ORKT) D PROC(PAR)

 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

ORKMGR    ; SLC/AEB,CLA - Manager Options - Order Checking Parameters ;9/22/97

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,85,105**;Dec 17, 1997

 +2       ;

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        SET PAR=PIEN

 +5        DO TITLE(ORKT)

           DO PROC(PAR)

 +6        QUIT 

 +7       ;

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