GMRCPZ.m

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 ---GMRCPZ   1673     printed  Apr 09, 2024@20:51:15                                                                                                                                                                                                      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       ;