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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCS 1301 printed Nov 22, 2024@16:57:16 Page 2
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
