GMRCALRT ;SLC/DCM - LIST MANAGER ALERT ACTION INTERFACE ;15-Mar-2012 10:38;PLS
;;3.0;CONSULT/REQUEST TRACKING;**1,4,26,1001,1003**;DEC 27, 1997;Build 14
;Modified - IHS/CIA/PLS - 5/6/2004 - Line HDR+3
; IHS/CIA/MGH - 11/29/2005 - Line INIT+4 - Modified to use HRCN instead of SSN
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)
;IHS/CIA/PLS - 5/6/2004
;S GMRVSTR="WT" D EN6^GMRVUTL S GMRCWT=$P(X,U,8)
S GMRCWT=$$VITAL^CIAVIHVT(DFN,"WT") ; IHS/CIA/PLS - redirect to PCC
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)
;IHS/CIA/MGH Modified to use HRCN instead of SSN
S GMRCHRCN=$$HRCN^GMRCMP(DFN,+$G(DUZ(2)))
S GMRCSSN=GMRCHRCN
;S GMRCSSN=$E(GMRCSN,1,3)_"-"_$E(GMRCSN,4,5)_"-"_$E(GMRCSN,6,9)
;---END MODIFICATION ---
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
;
GMRCALRT ;SLC/DCM - LIST MANAGER ALERT ACTION INTERFACE ;15-Mar-2012 10:38;PLS
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,26,1001,1003**;DEC 27, 1997;Build 14
+2 ;Modified - IHS/CIA/PLS - 5/6/2004 - Line HDR+3
+3 ; IHS/CIA/MGH - 11/29/2005 - Line INIT+4 - Modified to use HRCN instead of SSN
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 ;IHS/CIA/PLS - 5/6/2004
+4 ;S GMRVSTR="WT" D EN6^GMRVUTL S GMRCWT=$P(X,U,8)
+5 ; IHS/CIA/PLS - redirect to PCC
SET GMRCWT=$$VITAL^CIAVIHVT(DFN,"WT")
+6 DO DEM^GMRCU
IF '$DATA(GMRCWRD)
SET GMRCWRD=GMRCWARD
+7 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
+8 IF $DATA(GMRCWRD)
IF $LENGTH(GMRCWRD)
SET VALMHDR(2)="Ward: "_GMRCWRD
+9 QUIT
+10 ;
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 ;IHS/CIA/MGH Modified to use HRCN instead of SSN
+5 SET GMRCHRCN=$$HRCN^GMRCMP(DFN,+$GET(DUZ(2)))
+6 SET GMRCSSN=GMRCHRCN
+7 ;S GMRCSSN=$E(GMRCSN,1,3)_"-"_$E(GMRCSN,4,5)_"-"_$E(GMRCSN,6,9)
+8 ;---END MODIFICATION ---
+9 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)
+10 SET VALMCNT=LNCT
+11 KILL DSPLINE,DATA,LINE
+12 QUIT
+13 ;
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 ;
