GMRCALRT ;SLC/DCM - LIST MANAGER ALERT ACTION INTERFACE ; 6/6/02 14:23
 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,26**;DEC 27, 1997
EN(GMRCDAT,GMRCDTA) ; -- main entry point for GMRC ALERT ACTION
 ;Process an alert for a new consult through List Manager
 ;GMRCDTA=XQAID from CPRS interface
 ;GMRCDAT=XQADATA from CPRS interface = IFN of consult from file 123
 K GMRCQIT,GMRCOER,GMRCNOTF,GMRCCORY
 S GMRCALFL=$S($D(XQAID)&($D(XQADATA)):1,1:0)
 D EN^GMRCALOR(GMRCDTA,GMRCDAT)
 S GMRCNOTF=+$P(GMRCDTA,",",3)
 I $D(GMRCQIT) D  Q
 . S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF)
 . D DEL^ORB3FUP1(.GMRCCORY,GMRCDTA),EXIT Q
 D INIT,HDR
 N GMRCACTM
 I '+GMRCO S GMRCACTM=$O(^ORD(101,"B","GMRCACTM ALERT BASIC ACTIONS",0))_";ORD(101,"
 E  N ORFLG D
 . D CPRS^GMRCACTM(+GMRCO) ;Get users update status for the Consult entry
 . S GMRCACTM=$S(ORFLG(+GMRCO)>1:$O(^ORD(101,"B","GMRCACTM ALERT SERVICE ACTIONS",0))_";ORD(101,",1:$O(^ORD(101,"B","GMRCACTM ALERT BASIC ACTIONS",0))_";ORD(101,")
 I '+GMRCACTM K ^TMP("GMRC",$J,"CURRENT","MENU")
 E  S ^TMP("GMRC",$J,"CURRENT","MENU")=GMRCACTM,XQORM("HIJACK")=^("MENU")
 S GMRCOER=0
 D EN^VALM("GMRC ALERT ACTION")
 S XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF) D DEL^ORB3FUP1(.GMRCCORY,GMRCDTA)
 D EXIT
 Q
 ;
HDR ; -- header code
 N GMRVSTR,X
 S GMRCPTN=$P(^DPT(DFN,0),"^",1)
 S GMRVSTR="WT" D EN6^GMRVUTL S GMRCWT=$P(X,U,8)
 D DEM^GMRCU S:'$D(GMRCWRD) GMRCWRD=GMRCWARD
 S VALMHDR(1)=$E(GMRCPTN,1,30)_$S($L(GMRCPTN)<30:$E(TAB,1,30-$L(GMRCPTN)),1:" ")_GMRCSSN_$E(TAB,1,3)_GMRCDOB_$E(TAB,1,10-$L(GMRCDOB))_" ("_GMRCAGE_")"_$E(TAB,1,4)_"Wt (lb):"_GMRCWT
 I $D(GMRCWRD),$L(GMRCWRD) S VALMHDR(2)="Ward: "_GMRCWRD
 Q
 ;
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)
 S 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
 K DSPLINE,DATA,LINE
 Q
 ;
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
EXIT ; -- exit code
 K ^TMP("GMRCR",$J),^TMP("GMRCS",$J)
 K GMRCALFL,GMRCAID,GMRCQIT,VA,XQAKILL
 D ^GMRCREXT
 Q
 ;
EXPND ; -- expand code
 Q
 ;