- 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 Feb 18, 2025@23:13:36 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 ;