GMRCS.m

GMRCS ;SLC/DLT - Review consults by Patient and Service ;5/20/98  14:20

 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997

SELCT ;Select a Consult Type from the protocol file

 S DIC=101,DIC(0)="AEMQZ",DIC("A")="Select Consult Type: ",DIC("B")="GMRCT TPN" D ^DIC K DIC Q:Y<0  S GMRCCT=+7

 Q

SELPT K DIC S DIC=2,DIC("A")="Select Patient: ",DIC(0)="AEQM" D ^DIC K DIC S DFN=+Y

 I X="^"!(Y=-1) S GMRCQUT=1 K DFN Q

 D DEM^GMRCU

 Q

SELPR ;Get Procedure

 K GMRCPRNM,GMRCQUT

 S Y=$O(^ORD(101,"B","GMRCRM MEDICINE REQUEST TYPES",0)) Q:Y=""

 S XQORM=+Y_";ORD(101,",XQORM(0)="1A\",XQORM("A")="Select Procedure: ",XQORM("NO^^")=""

 D EN^XQORM K XQORM I Y<0 S GMRCQUT=1 K GMRCPR,GMRCPRNM,GMRCCT Q

 S GMRCPR=$P(Y(1),"^",2)

 Q

EXIT ;Exit action logic

 K GMRCA,GMRCACT,GMRCACTM,GMRCAGE,GMRCCT,GMRCCTX,GMRCDG,GMRCDGT,GMRCDOB,GMRCDTM,GMRCGRP,GMRCH,GMRCHDR,GMRCIFN,GMRCLFG,GMRCNM,GMRCNPG,GMRCPG,GMRCPNM,GMRCPR,GMRCRB,GMRCRPG

 K GMRCSN,GMRCSS,GMRCSSNM,GMRCTC,GMRCTITL,GMRCTM,GMRCTYPE,GMRCVP,GMRCWARD,SEX,VAROOT,W

 K DFN,HEAD,GMRCEND,GMRCORNP,GMRCORVP,GETPROV,GMRCDEV,GMRCDIC,GMRCPLI,GMRCPRI,GMRCURGI,GMRCGL,GMRCSR,GMRCSRDT,GMRCSRS,GMRCORVP,LASTA,MCBRANCH,MCC,MCK,MCPROC

 K O,ORGY,ORL,ORNP,ORNS,OREND,ORIOSL,ORPK,ORTKG,ORTO,ORTX,ORSTS,ORACTION,ORANSI,ORATTEND,ORI,ORSSN,ORTIT,ORTS,ORINDX,Z,ZTDESC

 Q

GMRCS     ;SLC/DLT - Review consults by Patient and Service ;5/20/98  14:20

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997

SELCT     ;Select a Consult Type from the protocol file

 +1        SET DIC=101

           SET DIC(0)="AEMQZ"

           SET DIC("A")="Select Consult Type: "

           SET DIC("B")="GMRCT TPN"

           DO ^DIC

           KILL DIC

           IF Y<0

               QUIT 

           SET GMRCCT=+7

 +2        QUIT 

SELPT      KILL DIC

           SET DIC=2

           SET DIC("A")="Select Patient: "

           SET DIC(0)="AEQM"

           DO ^DIC

           KILL DIC

           SET DFN=+Y

 +1        IF X="^"!(Y=-1)

               SET GMRCQUT=1

               KILL DFN

               QUIT 

 +2        DO DEM^GMRCU

 +3        QUIT 

SELPR     ;Get Procedure

 +1        KILL GMRCPRNM,GMRCQUT

 +2        SET Y=$ORDER(^ORD(101,"B","GMRCRM MEDICINE REQUEST TYPES",0))

           IF Y=""

               QUIT 

 +3        SET XQORM=+Y_";ORD(101,"

           SET XQORM(0)="1A\"

           SET XQORM("A")="Select Procedure: "

           SET XQORM("NO^^")=""

 +4        DO EN^XQORM

           KILL XQORM

           IF Y<0

               SET GMRCQUT=1

               KILL GMRCPR,GMRCPRNM,GMRCCT

               QUIT 

 +5        SET GMRCPR=$PIECE(Y(1),"^",2)

 +6        QUIT 

EXIT      ;Exit action logic

 +1        KILL GMRCA,GMRCACT,GMRCACTM,GMRCAGE,GMRCCT,GMRCCTX,GMRCDG,GMRCDGT,GMRCDOB,GMRCDTM,GMRCGRP,GMRCH,GMRCHDR,GMRCIFN,GMRCLFG,GMRCNM,GMRCNPG,GMRCPG,GMRCPNM,GMRCPR,GMRCRB,GMRCRPG

 +2        KILL GMRCSN,GMRCSS,GMRCSSNM,GMRCTC,GMRCTITL,GMRCTM,GMRCTYPE,GMRCVP,GMRCWARD,SEX,VAROOT,W

 +3        KILL DFN,HEAD,GMRCEND,GMRCORNP,GMRCORVP,GETPROV,GMRCDEV,GMRCDIC,GMRCPLI,GMRCPRI,GMRCURGI,GMRCGL,GMRCSR,GMRCSRDT,GMRCSRS,GMRCORVP,LASTA,MCBRANCH,MCC,MCK,MCPROC

 +4        KILL O,ORGY,ORL,ORNP,ORNS,OREND,ORIOSL,ORPK,ORTKG,ORTO,ORTX,ORSTS,ORACTION,ORANSI,ORATTEND,ORI,ORSSN,ORTIT,ORTS,ORINDX,Z,ZTDESC

 +5        QUIT