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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCALRT 2271 printed Dec 13, 2024@01:45:04 Page 2
GMRCALRT ;SLC/DCM - LIST MANAGER ALERT ACTION INTERFACE ; 6/6/02 14:23
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,26**;DEC 27, 1997
EN(GMRCDAT,GMRCDTA) ; -- main entry point for GMRC ALERT ACTION
+1 ;Process an alert for a new consult through List Manager
+2 ;GMRCDTA=XQAID from CPRS interface
+3 ;GMRCDAT=XQADATA from CPRS interface = IFN of consult from file 123
+4 KILL GMRCQIT,GMRCOER,GMRCNOTF,GMRCCORY
+5 SET GMRCALFL=$SELECT($DATA(XQAID)&($DATA(XQADATA)):1,1:0)
+6 DO EN^GMRCALOR(GMRCDTA,GMRCDAT)
+7 SET GMRCNOTF=+$PIECE(GMRCDTA,",",3)
+8 IF $DATA(GMRCQIT)
Begin DoDot:1
+9 SET XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF)
+10 DO DEL^ORB3FUP1(.GMRCCORY,GMRCDTA)
DO EXIT
QUIT
End DoDot:1
QUIT
+11 DO INIT
DO HDR
+12 NEW GMRCACTM
+13 IF '+GMRCO
SET GMRCACTM=$ORDER(^ORD(101,"B","GMRCACTM ALERT BASIC ACTIONS",0))_";ORD(101,"
+14 IF '$TEST
NEW ORFLG
Begin DoDot:1
+15 ;Get users update status for the Consult entry
DO CPRS^GMRCACTM(+GMRCO)
+16 SET GMRCACTM=$SELECT(ORFLG(+GMRCO)>1:$ORDER(^ORD(101,"B","GMRCACTM ALERT SERVICE ACTIONS",0))_";ORD(101,",1:$ORDER(^ORD(101,"B","GMRCACTM ALERT BASIC ACTIONS",0))_";ORD(101,")
End DoDot:1
+17 IF '+GMRCACTM
KILL ^TMP("GMRC",$JOB,"CURRENT","MENU")
+18 IF '$TEST
SET ^TMP("GMRC",$JOB,"CURRENT","MENU")=GMRCACTM
SET XQORM("HIJACK")=^("MENU")
+19 SET GMRCOER=0
+20 DO EN^VALM("GMRC ALERT ACTION")
+21 SET XQAKILL=$$XQAKILL^ORB3F1(GMRCNOTF)
DO DEL^ORB3FUP1(.GMRCCORY,GMRCDTA)
+22 DO EXIT
+23 QUIT
+24 ;
HDR ; -- header code
+1 NEW GMRVSTR,X
+2 SET GMRCPTN=$PIECE(^DPT(DFN,0),"^",1)
+3 SET GMRVSTR="WT"
DO EN6^GMRVUTL
SET GMRCWT=$PIECE(X,U,8)
+4 DO DEM^GMRCU
if '$DATA(GMRCWRD)
SET GMRCWRD=GMRCWARD
+5 SET VALMHDR(1)=$EXTRACT(GMRCPTN,1,30)_$SELECT($LENGTH(GMRCPTN)<30:$EXTRACT(TAB,1,30-$LENGTH(GMRCPTN)),1:" ")_GMRCSSN_$EXTRACT(TAB,1,3)_GMRCDOB_$EXTRACT(TAB,1,10-$LENGTH(GMRCDOB))_" ("_GMRCAGE_")"_$EXTRACT(TAB,1,4)_"Wt (lb):"_GMRCWT
+6 IF $DATA(GMRCWRD)
IF $LENGTH(GMRCWRD)
SET VALMHDR(2)="Ward: "_GMRCWRD
+7 QUIT
+8 ;
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)
+4 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
+7 KILL DSPLINE,DATA,LINE
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("GMRCR",$JOB),^TMP("GMRCS",$JOB)
+2 KILL GMRCALFL,GMRCAID,GMRCQIT,VA,XQAKILL
+3 DO ^GMRCREXT
+4 QUIT
+5 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
