- 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 Feb 18, 2025@23:13:22 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 ;
