- GMRCMP ;SLC/DCM - List Manager routine: Medical Service and sub-specialty consults ;5/20/98 14:20
- ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- 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"")"
- 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,VALMPGE=1,XQORM("A")="Select Action: "
- K DATA,DSPLINE,LINE
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K DFN,BLK,CDT,GMRC,GMRCDT1,GMRCDT2,GMRCAGE,GMRCDT1,GMRCDT2,GMRCND,GMRCNO,GMRCPTN,GMRCDOB,GMRCNM,GMRCNM,GMRCPNM,GMRCPRNM,GMRCSEX,GMRCSN,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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCMP 1325 printed Feb 18, 2025@23:12:40 Page 2
- GMRCMP ;SLC/DCM - List Manager routine: Medical Service and sub-specialty consults ;5/20/98 14:20
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- 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 SET GMRCSN=$PIECE(^DPT(DFN,0),"^",9)
- SET GMRCSSN=$EXTRACT(GMRCSN,1,3)_"-"_$EXTRACT(GMRCSN,4,5)_"-"_$EXTRACT(GMRCSN,6,9)
- +5 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)
- +6 SET VALMCNT=LNCT
- SET VALMPGE=1
- SET XQORM("A")="Select Action: "
- +7 KILL DATA,DSPLINE,LINE
- +8 QUIT
- +9 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL DFN,BLK,CDT,GMRC,GMRCDT1,GMRCDT2,GMRCAGE,GMRCDT1,GMRCDT2,GMRCND,GMRCNO,GMRCPTN,GMRCDOB,GMRCNM,GMRCNM,GMRCPNM,GMRCPRNM,GMRCSEX,GMRCSN,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 ;