GMRCPZ ;SLC/DCM - GMRC List Manager Routine -- Main menu actions for Pharmacy consults request tracking ;5/20/98 14:20
;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ; -- main entry point for GMRC PHARMACY TRK MAIN MENU
K ^TMP("GMRCR",$J),GMRCOER
D ^GMRCSSP I $D(GMRCQUT) K GMRCQUT,DFN Q
D EN^VALM("GMRC PHARMACY TRK MAIN MENU")
Q
;
HDR ; -- header code
Q:DFN<1
D HDR^GMRCSLM
Q
S GMRCPTN=$P(^DPT(DFN,0),"^",1),GMRCSSNM=$$LOWER^VALM1(GMRCSSNM),VALMHDR(1)="Patient Name: "_GMRCPTN_$E(TAB,1,38-$L(GMRCPTN))_"Service: "_GMRCSSNM
;
INIT ; -- init variables and list array
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,XQORM("A")="Select Action: "
K DSPLINE,LINE,DATA
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K BLK,CDT,CNT,LNCT,CTRLCOL,DFN,TAB,DFNS,SEX,LNCT,GMRCCT,GMRCDT,GMRCND,GMRCNO,GMRCRB,GMRCDT1,GMRCDT2,GMRCSEX,GMRCSN,GMRCAGE,GMRCDOB,GMRCPNM,GMRCQUT,GMRCPTN,GMRCSSN,GMRCSSNM,GMRCSVCN
K TO,PL,PROC,SEX,STS,POP,URG,LASTA,ORIOSL,ORPK,ZTDESC,IOTM,IOBM,GMRCQIT,GMRC,GMRCTITL,GMRCTM,GMRCVP,GMRCWARD,GMRCTYPE,GMRCSEL,GMRCTC,GMRCO,GMRCIFN,GMRCT,GMRCSS
K GMRCH,GMRCHDR,GMRCRPG,GMRCDG,GMRCDGT,GMRCNPG,GMRCACTM,GMRCNM,GMRCPRT,GMRC1,GMRC2,GMRCA,GETPROV,GMRCNAME,GMRCGRP,GMRCDA,GMRCDTM,GMRCACT,GMRCD,GMRCWRD,GMRCWT
K ORIFN,GMRCDFNS,GMRCFL,GMRCS1,GMRCS2,GMRCDT1,GMRCDT2,GMRCQUIT
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPZ 1673 printed Dec 13, 2024@01:46:59 Page 2
GMRCPZ ;SLC/DCM - GMRC List Manager Routine -- Main menu actions for Pharmacy consults request tracking ;5/20/98 14:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ; -- main entry point for GMRC PHARMACY TRK MAIN MENU
+1 KILL ^TMP("GMRCR",$JOB),GMRCOER
+2 DO ^GMRCSSP
IF $DATA(GMRCQUT)
KILL GMRCQUT,DFN
QUIT
+3 DO EN^VALM("GMRC PHARMACY TRK MAIN MENU")
+4 QUIT
+5 ;
HDR ; -- header code
+1 if DFN<1
QUIT
+2 DO HDR^GMRCSLM
+3 QUIT
+4 SET GMRCPTN=$PIECE(^DPT(DFN,0),"^",1)
SET GMRCSSNM=$$LOWER^VALM1(GMRCSSNM)
SET VALMHDR(1)="Patient Name: "_GMRCPTN_$EXTRACT(TAB,1,38-$LENGTH(GMRCPTN))_"Service: "_GMRCSSNM
+5 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("GMRCR",$JOB,"LIST")
+2 SET DSPLINE=0
SET VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
+3 SET GMRCSN=$PIECE(^DPT(DFN,0),"^",9)
SET GMRCSSN=$EXTRACT(GMRCSN,1,3)_"-"_$EXTRACT(GMRCSN,4,5)_"-"_$EXTRACT(GMRCSN,6,9)
+4 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)
+5 SET VALMCNT=LNCT
SET XQORM("A")="Select Action: "
+6 KILL DSPLINE,LINE,DATA
+7 QUIT
+8 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL BLK,CDT,CNT,LNCT,CTRLCOL,DFN,TAB,DFNS,SEX,LNCT,GMRCCT,GMRCDT,GMRCND,GMRCNO,GMRCRB,GMRCDT1,GMRCDT2,GMRCSEX,GMRCSN,GMRCAGE,GMRCDOB,GMRCPNM,GMRCQUT,GMRCPTN,GMRCSSN,GMRCSSNM,GMRCSVCN
+2 KILL TO,PL,PROC,SEX,STS,POP,URG,LASTA,ORIOSL,ORPK,ZTDESC,IOTM,IOBM,GMRCQIT,GMRC,GMRCTITL,GMRCTM,GMRCVP,GMRCWARD,GMRCTYPE,GMRCSEL,GMRCTC,GMRCO,GMRCIFN,GMRCT,GMRCSS
+3 KILL GMRCH,GMRCHDR,GMRCRPG,GMRCDG,GMRCDGT,GMRCNPG,GMRCACTM,GMRCNM,GMRCPRT,GMRC1,GMRC2,GMRCA,GETPROV,GMRCNAME,GMRCGRP,GMRCDA,GMRCDTM,GMRCACT,GMRCD,GMRCWRD,GMRCWT
+4 KILL ORIFN,GMRCDFNS,GMRCFL,GMRCS1,GMRCS2,GMRCDT1,GMRCDT2,GMRCQUIT
+5 QUIT
+6 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
