GMRCPZ.m

GMRCPZ ;SLC/DCM - GMRC List Manager Routine -- Main menu actions for Pharmacy consults request tracking ;15-Mar-2012 10:41;PLS

 ;;3.0;CONSULT/REQUEST TRACKING;**1,1001,1003**;DEC 27, 1997;Build 14

 ;Modified - IHS/CIA/MGH - 11/29/2005 - Line INIT+3, EXIT+5  - Code change to use HRCN instead of SSN

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"")"

 ;IHS/CIA/MGH Code changed to use HRCN instead of SSN

 ;S GMRCSN=$P(^DPT(DFN,0),"^",9),GMRCSSN=$E(GMRCSN,1,3)_"-"_$E(GMRCSN,4,5)_"-"_$E(GMRCSN,6,9)

 S GMRCHRCN=$$HRCN^GMRCMP(DFN,+$G(DUZ(2))),GMRCSSN=GMRCHRCN

 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

 K GMRCHRCN  ; IHS/CIA/MGH

 Q

 ;

EXPND ; -- expand code

 Q

 ;

GMRCPZ    ;SLC/DCM - GMRC List Manager Routine -- Main menu actions for Pharmacy consults request tracking ;15-Mar-2012 10:41;PLS

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**1,1001,1003**;DEC 27, 1997;Build 14

 +2       ;Modified - IHS/CIA/MGH - 11/29/2005 - Line INIT+3, EXIT+5  - Code change to use HRCN instead of SSN

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       ;IHS/CIA/MGH Code changed to use HRCN instead of SSN

 +4       ;S GMRCSN=$P(^DPT(DFN,0),"^",9),GMRCSSN=$E(GMRCSN,1,3)_"-"_$E(GMRCSN,4,5)_"-"_$E(GMRCSN,6,9)

 +5        SET GMRCHRCN=$$HRCN^GMRCMP(DFN,+$GET(DUZ(2)))

           SET GMRCSSN=GMRCHRCN

 +6        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)

 +7        SET VALMCNT=LNCT

           SET XQORM("A")="Select Action: "

 +8        KILL DSPLINE,LINE,DATA

 +9        QUIT 

 +10      ;

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       ; IHS/CIA/MGH

           KILL GMRCHRCN

 +6        QUIT 

 +7       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;