GMRCMP.m

GMRCMP ;SLC/DCM - List Manager routine: Medical Service and sub-specialty consults ;15-Mar-2012 10:40;PLS

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

 ;Modified - IHS/CIA/MGH -11/29/2005 - Line INIT+4 - Modified to use HRCN instead of SSN

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

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

 S 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,VALMPGE=1,XQORM("A")="Select Action: "

 K DATA,DSPLINE,LINE

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

HRCN(DFN,SITE) ;EP  IHS/CIA/MGH  Get the health record number for a patient at this site

 Q $P($G(^AUPNPAT(DFN,41,SITE,0)),U,2)

 ;

EXIT ; -- exit code

 K DFN,BLK,CDT,GMRC,GMRCDT1,GMRCDT2,GMRCAGE,GMRCDT1,GMRCDT2,GMRCND,GMRCNO,GMRCPTN,GMRCDOB,GMRCNM,GMRCNM,GMRCPNM,GMRCPRNM,GMRCSEX,GMRCSN,GMRCHRCN,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

 ;

GMRCMP    ;SLC/DCM - List Manager routine: Medical Service and sub-specialty consults ;15-Mar-2012 10:40;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+4 - Modified to use HRCN instead of SSN

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

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

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

 +7        SET GMRCSSN=GMRCHRCN

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

 +9        SET VALMCNT=LNCT

           SET VALMPGE=1

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

 +10       KILL DATA,DSPLINE,LINE

 +11       QUIT 

 +12      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

HRCN(DFN,SITE) ;EP  IHS/CIA/MGH  Get the health record number for a patient at this site

 +1        QUIT $PIECE($GET(^AUPNPAT(DFN,41,SITE,0)),U,2)

 +2       ;

EXIT      ; -- exit code

 +1        KILL DFN,BLK,CDT,GMRC,GMRCDT1,GMRCDT2,GMRCAGE,GMRCDT1,GMRCDT2,GMRCND,GMRCNO,GMRCPTN,GMRCDOB,GMRCNM,GMRCNM,GMRCPNM,GMRCPRNM,GMRCSEX,GMRCSN,GMRCHRCN,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       ;