- 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 Jan 18, 2025@02:46:18 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 ;