GMRCSLMA ;SLC/DLT - List Manager protocol entry, exit actions ; 11/25/2000
;;3.0;CONSULT/REQUEST TRACKING;**4,18,63**;DEC 27, 1997;Build 10
; This routine invokes IA #875,#2638
;Variables used in entry and exit actions
; GMRCALFL is 1 flags the action is executing from an alert
; set logic is GMRCALFL=$S($D(XQAID)&($D(XQADATA):1,1:0)
; VALMBCK="R" to refresh screen
; =NULL to clear bottom portion of screen and prompt for action
; =Q to exit List manager
; GMRC("NMBR") = the currently highlighed entry in the list
; BLK=
; LNCT= Set to 1 if the GMRCALFL flag is 1
; GMRCQUT= if defined than exit list manager?
; GMRCEN = defined if branched to date range prompt by EN^GMRCSLM
; GMRCOER= used to indicate whether CPRS or consults initiated action
; 0 for Consults List Manager
; 1 for GUI
; 2 for CPRS Consults tab to Detailed Display
; ^TMP("GMRC",$J,"CURRENT","MENU"))= the action menu for user
; based on the service by EN^GMRCMENU
;Entry points called:
; AD^GMRCSLM1 ;Loop through AD cross-reference doing SET
; SET^GMRCSLM1 ;Format entries into ^TMP("GMRCR",$J,"CS"
; INIT^GMRCSLM ;Initialize variables and list array
; END^GMRCSLM1 ;Resets BLK and LNCT and kills variables
; HDR^GMRCSLM ;Reset the VALMHDR values
; AGAIN^GMRCSLMV(GMRC("NMBR")) ;Reset the video attribute only, do not redisplay
; RESET^GMRCSLMV(GMRC("NMBR")) ;turn reverse video off when another item is selected
;
ENTRY(TYPE) ; -- Entry action for list manager actions
;Actions: RT,DT
;TYPE="" when the list and header have no change
;TYPE["L"
; Assumes Rebuild the list due to change in the list information
; Use for GMRCACT CANCEL REQUEST, GMRCACT DISCONTINUE
; GMRCACT COMPLETE,GMRCACT EDIT/RESUBMIT
;TYPE["H"
; Assumes need to rebuild the header too due to change in the list
; manager used while processing the action
; Use for GMRCACT COMPLETE, DD, RT, since it goes to TIU
S VALMBCK="R"
;Q:$D(GMRCQUT)
;
I $D(GMRCALFL) D Q ;Processing from an alert, quit
. K ^TMP("GMRCR",$J,"CS"),GMRCDA
. S BLK=0,LNCT=1
. S VALMBCK="R"
. D SET^GMRCSLM1
. D INIT^GMRCSLM
. S VALMCNT=1
. ;D END^GMRCSLM1 ;cancel,receive
. Q
;
;Processing from Consults action
I $G(TYPE)["L" D AD^GMRCSLM1,INIT^GMRCSLM S VALMBG=1
I $G(TYPE)["H" D HDR^GMRCSLM,INIT^GMRCSLM
Q
;alert logic not flushed out
;. I $G(TYPE)["L" D
;. . ; rebuild the list
;. . K ^TMP("GMRCR",$J,"CS")
;. . D SET^GMRCSLM1
;. . D INIT^GMRCSLM
;. I $G(TYPE)["H" D HDR^GMRCSLM,INIT^GMRCSLM
;. I $G(TYPE)["L" D END^GMRCSLM1 ;cancel,receive
;. Q
;
EXIT(LINE) ; -- Exit action for list manager to refresh screen and reset the menu
;Actions using this: RT,DT
;LINE contains "A" Re-highlight line on list
;LINE contains "R" Remove highlight on list
;Used by GMRCACT CANCEL REQUEST,GMRCACT COMMENT ORDERS,
; GMRCACT EDIT/RESUBMIT
I "A"[LINE,$D(GMRC("NMBR")) D AGAIN^GMRCSLMV(GMRC("NMBR")) ;DD entry and RD exit action
I "R"[LINE,$D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
S VALMBCK="R"
S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
S VALMBG=1
K GMRCSEL,GMRCO,GMRCND
Q
;
PHDR ; -- protocol header code called from the protocol action menus
;S VALMSG=$$MSG
D SHOW^VALM
S XQORM("#")=$O(^ORD(101,"B","GMRC SELECT ITEM",0))_"^1:"_VALMCNT
S XQORM("A")="Select: "
S XQORM("KEY","EX")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
S XQORM("KEY","Q")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
S XQORM("KEY","CLOSE")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
S XQORM("KEY","NX")=$O(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
S XQORM("KEY","NEXT")=$O(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
S XQORM("KEY","PS")=$O(^ORD(101,"B","GMRCACT PRINT CONSULT FORM",0))_"^1"
S XQORM("KEY","CM")=$O(^ORD(101,"B","GMRCACT COMMENT ORDERS",0))_"^1"
K GMRCNMBR
Q
;I '+$G(OVRRIDE),$$VALID^GMRCAU(+$G(GMRCSS)) D ;set 2.5 mnem's into XQORM("KEY")
;. S XQORM("KEY","AC")="$O(^ORD(101,"B","GMRCACT ADMIN COMPLETE",0)_"^1"
;. S XQORM("KEY","DY")=$O(^ORD(101,"B","GMRCACT CANCEL",0))_"^1"
;. S XQORM("KEY","ED")=$O(^ORD(101,"B","GMRC CHANGE ORDERS",0))_"^1"
Q
MSG() ; -- LMgr message bar
Q "Enter the number of the item you wish to act on, or select an action."
;
MARGIN ; -- Reset bottom margin if menu display off
N BM S BM=$S(VALMMENU:17,1:21) Q:BM=VALM("BM") ; no change
S VALM("BM")=BM,VALM("LINES")=VALM("BM")-VALM("TM")+1,VALMBCK="R"
Q
;
SELEXIT ; -- Exit action for list manager when selection criteria changed
S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
S VALMBCK="R"
Q:($D(GMRCQUT)!$D(GMRCQUIT)) ;status exit using GMRCQUIT??
I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
D AD^GMRCSLM1
D INIT^GMRCSLM ;from select patient, select service
D HDR^GMRCSLM ;from select patient, select date range
K GMRCSEL,GMRCO,GMRCND
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSLMA 5019 printed Sep 23, 2025@19:23:15 Page 2
GMRCSLMA ;SLC/DLT - List Manager protocol entry, exit actions ; 11/25/2000
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,18,63**;DEC 27, 1997;Build 10
+2 ; This routine invokes IA #875,#2638
+3 ;Variables used in entry and exit actions
+4 ; GMRCALFL is 1 flags the action is executing from an alert
+5 ; set logic is GMRCALFL=$S($D(XQAID)&($D(XQADATA):1,1:0)
+6 ; VALMBCK="R" to refresh screen
+7 ; =NULL to clear bottom portion of screen and prompt for action
+8 ; =Q to exit List manager
+9 ; GMRC("NMBR") = the currently highlighed entry in the list
+10 ; BLK=
+11 ; LNCT= Set to 1 if the GMRCALFL flag is 1
+12 ; GMRCQUT= if defined than exit list manager?
+13 ; GMRCEN = defined if branched to date range prompt by EN^GMRCSLM
+14 ; GMRCOER= used to indicate whether CPRS or consults initiated action
+15 ; 0 for Consults List Manager
+16 ; 1 for GUI
+17 ; 2 for CPRS Consults tab to Detailed Display
+18 ; ^TMP("GMRC",$J,"CURRENT","MENU"))= the action menu for user
+19 ; based on the service by EN^GMRCMENU
+20 ;Entry points called:
+21 ; AD^GMRCSLM1 ;Loop through AD cross-reference doing SET
+22 ; SET^GMRCSLM1 ;Format entries into ^TMP("GMRCR",$J,"CS"
+23 ; INIT^GMRCSLM ;Initialize variables and list array
+24 ; END^GMRCSLM1 ;Resets BLK and LNCT and kills variables
+25 ; HDR^GMRCSLM ;Reset the VALMHDR values
+26 ; AGAIN^GMRCSLMV(GMRC("NMBR")) ;Reset the video attribute only, do not redisplay
+27 ; RESET^GMRCSLMV(GMRC("NMBR")) ;turn reverse video off when another item is selected
+28 ;
ENTRY(TYPE) ; -- Entry action for list manager actions
+1 ;Actions: RT,DT
+2 ;TYPE="" when the list and header have no change
+3 ;TYPE["L"
+4 ; Assumes Rebuild the list due to change in the list information
+5 ; Use for GMRCACT CANCEL REQUEST, GMRCACT DISCONTINUE
+6 ; GMRCACT COMPLETE,GMRCACT EDIT/RESUBMIT
+7 ;TYPE["H"
+8 ; Assumes need to rebuild the header too due to change in the list
+9 ; manager used while processing the action
+10 ; Use for GMRCACT COMPLETE, DD, RT, since it goes to TIU
+11 SET VALMBCK="R"
+12 ;Q:$D(GMRCQUT)
+13 ;
+14 ;Processing from an alert, quit
IF $DATA(GMRCALFL)
Begin DoDot:1
+15 KILL ^TMP("GMRCR",$JOB,"CS"),GMRCDA
+16 SET BLK=0
SET LNCT=1
+17 SET VALMBCK="R"
+18 DO SET^GMRCSLM1
+19 DO INIT^GMRCSLM
+20 SET VALMCNT=1
+21 ;D END^GMRCSLM1 ;cancel,receive
+22 QUIT
End DoDot:1
QUIT
+23 ;
+24 ;Processing from Consults action
+25 IF $GET(TYPE)["L"
DO AD^GMRCSLM1
DO INIT^GMRCSLM
SET VALMBG=1
+26 IF $GET(TYPE)["H"
DO HDR^GMRCSLM
DO INIT^GMRCSLM
+27 QUIT
+28 ;alert logic not flushed out
+29 ;. I $G(TYPE)["L" D
+30 ;. . ; rebuild the list
+31 ;. . K ^TMP("GMRCR",$J,"CS")
+32 ;. . D SET^GMRCSLM1
+33 ;. . D INIT^GMRCSLM
+34 ;. I $G(TYPE)["H" D HDR^GMRCSLM,INIT^GMRCSLM
+35 ;. I $G(TYPE)["L" D END^GMRCSLM1 ;cancel,receive
+36 ;. Q
+37 ;
EXIT(LINE) ; -- Exit action for list manager to refresh screen and reset the menu
+1 ;Actions using this: RT,DT
+2 ;LINE contains "A" Re-highlight line on list
+3 ;LINE contains "R" Remove highlight on list
+4 ;Used by GMRCACT CANCEL REQUEST,GMRCACT COMMENT ORDERS,
+5 ; GMRCACT EDIT/RESUBMIT
+6 ;DD entry and RD exit action
IF "A"[LINE
IF $DATA(GMRC("NMBR"))
DO AGAIN^GMRCSLMV(GMRC("NMBR"))
+7 IF "R"[LINE
IF $DATA(GMRC("NMBR"))
DO RESET^GMRCSLMV(GMRC("NMBR"))
KILL GMRC("NMBR")
+8 SET VALMBCK="R"
+9 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+10 SET VALMBG=1
+11 KILL GMRCSEL,GMRCO,GMRCND
+12 QUIT
+13 ;
PHDR ; -- protocol header code called from the protocol action menus
+1 ;S VALMSG=$$MSG
+2 DO SHOW^VALM
+3 SET XQORM("#")=$ORDER(^ORD(101,"B","GMRC SELECT ITEM",0))_"^1:"_VALMCNT
+4 SET XQORM("A")="Select: "
+5 SET XQORM("KEY","EX")=$ORDER(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
+6 SET XQORM("KEY","Q")=$ORDER(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
+7 SET XQORM("KEY","CLOSE")=$ORDER(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
+8 SET XQORM("KEY","NX")=$ORDER(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
+9 SET XQORM("KEY","NEXT")=$ORDER(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
+10 SET XQORM("KEY","PS")=$ORDER(^ORD(101,"B","GMRCACT PRINT CONSULT FORM",0))_"^1"
+11 SET XQORM("KEY","CM")=$ORDER(^ORD(101,"B","GMRCACT COMMENT ORDERS",0))_"^1"
+12 KILL GMRCNMBR
+13 QUIT
+14 ;I '+$G(OVRRIDE),$$VALID^GMRCAU(+$G(GMRCSS)) D ;set 2.5 mnem's into XQORM("KEY")
+15 ;. S XQORM("KEY","AC")="$O(^ORD(101,"B","GMRCACT ADMIN COMPLETE",0)_"^1"
+16 ;. S XQORM("KEY","DY")=$O(^ORD(101,"B","GMRCACT CANCEL",0))_"^1"
+17 ;. S XQORM("KEY","ED")=$O(^ORD(101,"B","GMRC CHANGE ORDERS",0))_"^1"
+18 QUIT
MSG() ; -- LMgr message bar
+1 QUIT "Enter the number of the item you wish to act on, or select an action."
+2 ;
MARGIN ; -- Reset bottom margin if menu display off
+1 ; no change
NEW BM
SET BM=$SELECT(VALMMENU:17,1:21)
if BM=VALM("BM")
QUIT
+2 SET VALM("BM")=BM
SET VALM("LINES")=VALM("BM")-VALM("TM")+1
SET VALMBCK="R"
+3 QUIT
+4 ;
SELEXIT ; -- Exit action for list manager when selection criteria changed
+1 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+2 SET VALMBCK="R"
+3 ;status exit using GMRCQUIT??
if ($DATA(GMRCQUT)!$DATA(GMRCQUIT))
QUIT
+4 IF $DATA(GMRC("NMBR"))
DO RESET^GMRCSLMV(GMRC("NMBR"))
KILL GMRC("NMBR")
+5 DO AD^GMRCSLM1
+6 ;from select patient, select service
DO INIT^GMRCSLM
+7 ;from select patient, select date range
DO HDR^GMRCSLM
+8 KILL GMRCSEL,GMRCO,GMRCND
+9 QUIT
+10 ;
