GMRCMP ;SLC/DCM - List Manager routine: Medical Service and sub-specialty consults ;5/20/98 14:20
;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ; -- main entry point for GMRC TRK MEDICINE CONSULTS
K GMRCQUT
D EN^GMRCMCP I $D(GMRCQUT) D EXIT Q
D EN^VALM("GMRC TRK MEDICINE CONSULTS")
D EXIT
Q
;
HDR ; -- header code
D HDR^GMRCSLM
Q
;
INIT ; -- init variables and list array
D KILL^VALM10(),CLEAR^VALM1
K ^TMP("GMRCR",$J,"LIST")
S DSPLINE=0,VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
S GMRCSN=$P(^DPT(DFN,0),"^",9),GMRCSSN=$E(GMRCSN,1,3)_"-"_$E(GMRCSN,4,5)_"-"_$E(GMRCSN,6,9)
F LINE=1:1:LNCT S DSPLINE=$O(^TMP("GMRCR",$J,"CS",DSPLINE)) Q:DSPLINE=""!(DSPLINE?1A.E) S DATA=^(DSPLINE,0) D SET^VALM10(LINE,DATA)
S VALMCNT=LNCT,VALMPGE=1,XQORM("A")="Select Action: "
K DATA,DSPLINE,LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K DFN,BLK,CDT,GMRC,GMRCDT1,GMRCDT2,GMRCAGE,GMRCDT1,GMRCDT2,GMRCND,GMRCNO,GMRCPTN,GMRCDOB,GMRCNM,GMRCNM,GMRCPNM,GMRCPRNM,GMRCSEX,GMRCSN,GMRCSSN,GMRCSSNM,LNCT,SEX,TAB
K GMRCDT,GMRCSA,GMRCSVCN,GMRCVP,GMRCFL,GMRCWT,GMRCWRD,GMRCVP,GMRCTM,GMRCBM,GMRCFL,GMRCSS,GMRCFLG,GMRCPR,GMRCRB,GMRCTYPE,GMRCWARD,GMRCNM,GMRCSS,GMRCSSNM,GMRCSVCN,GMRCWARD,GMRCWRD
K GMRCACTM,GMRCSTCK,GMRCOER
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCMP 1325 printed Dec 13, 2024@01:46:18 Page 2
GMRCMP ;SLC/DCM - List Manager routine: Medical Service and sub-specialty consults ;5/20/98 14:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ; -- main entry point for GMRC TRK MEDICINE CONSULTS
+1 KILL GMRCQUT
+2 DO EN^GMRCMCP
IF $DATA(GMRCQUT)
DO EXIT
QUIT
+3 DO EN^VALM("GMRC TRK MEDICINE CONSULTS")
+4 DO EXIT
+5 QUIT
+6 ;
HDR ; -- header code
+1 DO HDR^GMRCSLM
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 DO KILL^VALM10()
DO CLEAR^VALM1
+2 KILL ^TMP("GMRCR",$JOB,"LIST")
+3 SET DSPLINE=0
SET VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
+4 SET GMRCSN=$PIECE(^DPT(DFN,0),"^",9)
SET GMRCSSN=$EXTRACT(GMRCSN,1,3)_"-"_$EXTRACT(GMRCSN,4,5)_"-"_$EXTRACT(GMRCSN,6,9)
+5 FOR LINE=1:1:LNCT
SET DSPLINE=$ORDER(^TMP("GMRCR",$JOB,"CS",DSPLINE))
if DSPLINE=""!(DSPLINE?1A.E)
QUIT
SET DATA=^(DSPLINE,0)
DO SET^VALM10(LINE,DATA)
+6 SET VALMCNT=LNCT
SET VALMPGE=1
SET XQORM("A")="Select Action: "
+7 KILL DATA,DSPLINE,LINE
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL DFN,BLK,CDT,GMRC,GMRCDT1,GMRCDT2,GMRCAGE,GMRCDT1,GMRCDT2,GMRCND,GMRCNO,GMRCPTN,GMRCDOB,GMRCNM,GMRCNM,GMRCPNM,GMRCPRNM,GMRCSEX,GMRCSN,GMRCSSN,GMRCSSNM,LNCT,SEX,TAB
+2 KILL GMRCDT,GMRCSA,GMRCSVCN,GMRCVP,GMRCFL,GMRCWT,GMRCWRD,GMRCVP,GMRCTM,GMRCBM,GMRCFL,GMRCSS,GMRCFLG,GMRCPR,GMRCRB,GMRCTYPE,GMRCWARD,GMRCNM,GMRCSS,GMRCSSNM,GMRCSVCN,GMRCWARD,GMRCWRD
+3 KILL GMRCACTM,GMRCSTCK,GMRCOER
+4 QUIT
+5 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
