GMRCMED ;SLC/JFR - MEDICINE INTERFACE ROUTINES; 2/20/01 13:32
;;3.0;CONSULT/REQUEST TRACKING;**15,47**;DEC 27, 1997
;
; This routine invokes IA #147,#2757,#3160,#3171
;
SET(NUM) ; set selected med result into GMRCMEDR
I NUM<1!(NUM>VALMCNT) D Q
. W !,$C(7),NUM_" is not a valid selection. "
. W !,"Choose a number between 1 and "_VALMCNT
I '$D(^TMP("GMRCR",$J,"DT",NUM,1)) D Q
. D EXAC^GMRCADC("The displayed item is not selectable")
I $D(GMRCMEDR) D RESETIT(GMRCMEDR)
S GMRCMEDR=NUM
D CNTRL^VALM10(NUM,1,80,IORVON,IORVOFF)
D WRITE^VALM10(NUM)
S VALMBCK=""
Q
RESETIT(NUM) ;return prev. selected number to normal video
D CNTRL^VALM10(NUM,1,80,IOINORM,IOINORM)
D WRITE^VALM10(NUM)
S VALMBCK="" K GMRCSEL
Q
RESULTS(ROOT,GMRCDFN) ;get list of results from Medicine
; ROOT = "MCAR(691","MCAR(691.5" etc. (global root w/o comma)
; return list formatted in ^TMP("GMRCMC",$J
N S5,CNT,REC
K ^TMP("GMRCMC",$J)
S S5=ROOT D EN^MCARPS2(GMRCDFN)
I '$D(^TMP("OR",$J,"MCAR")) D Q
. ;D EXAC^GMRCADC("No results found for"_$P(ROOT,U,2))
S CNT=1,REC=0
F S REC=$O(^TMP("OR",$J,"MCAR","OT",REC)) Q:'REC D
. N MCDATA,DATA,ONEDATA
. S MCDATA=^TMP("OR",$J,"MCAR","OT",REC),DATA=""
. Q:$D(^GMR(123,"R",$P(MCDATA,U,2)_";"_ROOT_","))
. Q:$$SCRNDRFT($P(MCDATA,U,2),$P(ROOT,"(",2))
. S DATA=$$SETSTR^VALM1(CNT,DATA,2,$L(REC))
. S DATA=$$SETSTR^VALM1($P(MCDATA,U),DATA,6,23)
. S DATA=$$SETSTR^VALM1($P(MCDATA,U,6),DATA,30,$L($P(MCDATA,U,6)))
. S DATA=$$SETSTR^VALM1($P(MCDATA,U,7),DATA,50,$L($P(MCDATA,U,7)))
. S ^TMP("GMRCR",$J,"DT",CNT,0)=DATA
. ;S ONEDATA=REC_U_$P(MCDATA,U,2)_";"_ROOT_","_U_$P(MCDATA,U,3,5)
. ;S ONEDATA=ONEDATA_U_$P(MCDATA,U,11)
. S ONEDATA=$P(MCDATA,U,2)_";"_ROOT_","
. S ^TMP("GMRCR",$J,"DT",CNT,1)=ONEDATA
. S CNT=CNT+1
K ^TMP("OR",$J,"MCAR")
Q
PHDR ;set protocols into actions
S VALMSG=$$CJ^XLFSTR("Select action or item number ?? for help",80)
S XQORM("M")=3
D SHOW^VALM
S XQORM("#")=$O(^ORD(101,"B","GMRCACT SELECT MED RESULT",0))_"^1:"_VALMCNT
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","AR")=$O(^ORD(101,"B","GMRCACT ASSOCIATE RESULTS",0))_"^1"
S XQORM("KEY","DR")=$O(^ORD(101,"B","GMRCACT DISPLAY MED RESULT",0))_"^1"
Q
;
SELECT(CNT) ;grab an item from list
N DIR,DUOUT,DTOUT,DIRUT,X,Y
S DIR(0)="NO^1:"_CNT,DIR("A")="Select item"
D ^DIR I $D(DIRUT) Q 0
Q +Y
;
DISPRES(ITEM) ;
I '+$G(^TMP("GMRCR",$J,"DT",1,1)) D Q ; no result there
. D EXAC^GMRCADC("There are no results to display")
N GMRCDFN
I '$G(ITEM),'$G(GMRCMEDR) D Q:'ITEM
. S ITEM=$$SELECT(VALMCNT)
. D SET(ITEM)
I $G(GMRCMEDR) S ITEM=GMRCMEDR
N I,GMRCRES,GMRCDFN,GMRCVTIT
S GMRCRES=$G(^TMP("GMRCR",$J,"DT",ITEM,1))
Q:'$L(GMRCRES)
M ^TMP("GMRCR",$J,"DTSV")=^TMP("GMRCR",$J,"DT")
K ^TMP("GMRCR",$J,"DT")
S GMRCDFN=$G(DFN)
D START^ORWRP(80,"EN^MCAPI(GMRCRES)")
I '$D(^TMP("ORDATA",$J,1)) D Q
. S ^TMP("GMRCR",$J,"DTLIST",1,0)="Unable to locate result"
S I=0 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:'I D
. S ^TMP("GMRCR",$J,"DTLIST",I,0)=^TMP("ORDATA",$J,1,I)
K ^TMP("ORDATA",$J) ; clean up from OR WORKSTATION
S DFN=$S(+GMRCDFN:GMRCDFN,$G(ORVP):+ORVP,1:0)
S GMRCVTIT="Medicine Result Display"
S VALMCNT=$O(^TMP("GMRCR",$J,"DTLIST",999999),-1)
D EN^VALM("GMRC DETAILED DISPLAY")
M ^TMP("GMRCR",$J,"DT")=^TMP("GMRCR",$J,"DTSV")
K ^TMP("GMRCR",$J,"DTSV")
S VALMBCK="R",VALMCNT=$O(^TMP("GMRCR",$J,"DT",999999),-1)
Q
;
AR(ITEM) ;associate specific result and complete consult
I '+$G(^TMP("GMRCR",$J,"DT",1,1)) D Q ; no result there
. D EXAC^GMRCADC("There are no results to associate")
N DIR,X,Y,RESTXT,RESULT
I '$G(ITEM),'$G(GMRCMEDR) D Q:'ITEM
. S ITEM=$$SELECT(VALMCNT)
. D SET(ITEM)
I $G(GMRCMEDR) S ITEM=GMRCMEDR
D FULL^VALM1
S RESTXT=$E(^TMP("GMRCR",$J,"DT",ITEM,0),6,80)
S RESULT=^TMP("GMRCR",$J,"DT",ITEM,1) Q:'+RESULT
I $D(^GMR(123,"R",RESULT)) D Q
. D EXAC^GMRCADC("This result is already associated with a procedure.")
S DIR(0)="YA",DIR("B")="NO"
S DIR("A",1)="",DIR("A",2)=" "_RESTXT,DIR("A",3)=""
S DIR("A")="Are you sure you want to associate this result? "
D ^DIR I Y<1 Q
D MEDCOMP(GMRCO,RESULT,$$NOW^XLFDT,DUZ)
Q
MEDCOMP(GMRCDA,GMRCRSLT,GMRCAD,GMRCORNP,GMRCALRT) ;add medicine result
; update status and send alerts
; Input:
; GMRCDA - ien from file 123
; GMRCRSLT - medicine result in var ptr form (e.g. "19;MCAR(691.5,")
; GMRCAD - FM date/time of action (optional)
; GMRCORNP - DUZ of person taking action
; GMRCALRT - array of users to receive alert (optional)
;
I '$D(GMRCDA)!'$D(GMRCRSLT) Q
N GMRCO,GMRCSTS,GMRCA,GMRCDR,GMRCTYP,MSG
S GMRCO=GMRCDA,GMRCA=10,GMRCSTS=2
S GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;11////^S X=GMRCRSLT"
D STATUS^GMRCP
I $D(GMRCAD) D AUDIT^GMRCP
I '$D(GMRCAD) D AUDIT0^GMRCP
D ADDRSLT^GMRCTIUA(GMRCDA,GMRCRSLT)
S MSG="NEW RESULT ASSOCIATED",GMRCDFN=$P(^GMR(123,GMRCO,0),U,2)
D MSG^GMRCP(GMRCDFN,MSG,GMRCDA,23,.GMRCALRT,0)
S GMRCTYP=$P(^GMR(123,+GMRCDA,0),U,17)
D EN^GMRCHL7(GMRCDFN,GMRCDA,GMRCTYP,"","RE",$G(GMRCORNP),"")
Q
REFRESH(GMRCIEN) ;update list of available results
N MCROOT,MCPROC,GMRCPROC
I $G(GMRCMEDR) D RESETIT(GMRCMEDR)
K ^TMP("GMRCR",$J,"DT"),GMRCMEDR
S GMRCPROC=$P(^GMR(123,GMRCIEN,0),"^",8)
S MCROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,+GMRCPROC,0),U,5),1)
D RESULTS^GMRCMED(MCROOT,$P(^GMR(123,+GMRCIEN,0),U,2))
I '$O(^TMP("GMRCR",$J,"DT",0)) D
. S ^TMP("GMRCR",$J,"DT",1,0)="No further results to associate"
S VALMCNT=$O(^TMP("GMRCR",$J,"DT",""),-1)
S VALMBCK="R"
Q
;
SCRNDRFT(GMRCMCDA,GMRCMCFL) ;screen out draft or marked for del med results
; Input:
; GMRCDA - ien from a MEDICINE file
; GMRCMCFL - file # from MEDICINE (e.g. 691, 691.5, 699 etc.)
; Output: Boolean 1=screen it out 0=include it
;
N GMRCMCST,GMRCMFD
I '$D(GMRCMCDA)!('$D(GMRCMCFL)) Q 0
S GMRCMCST=$$GET1^DIQ(GMRCMCFL,GMRCMCDA,1506,"I") ;get release code
S GMRCMCST=$S(GMRCMCST="D":0,GMRCMCST="PD":0,1:1) ;no D or PD
S GMRCMFD=$$GET1^DIQ(GMRCMCFL,GMRCMCDA,1511,"I") ;marked for del?
I GMRCMFD=1 Q 1 ;marked for del
I GMRCMCST=0 Q 1 ;screen out draft or prob draft
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCMED 6425 printed Apr 09, 2024@20:51:54 Page 2
GMRCMED ;SLC/JFR - MEDICINE INTERFACE ROUTINES; 2/20/01 13:32
+1 ;;3.0;CONSULT/REQUEST TRACKING;**15,47**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #147,#2757,#3160,#3171
+4 ;
SET(NUM) ; set selected med result into GMRCMEDR
+1 IF NUM<1!(NUM>VALMCNT)
Begin DoDot:1
+2 WRITE !,$CHAR(7),NUM_" is not a valid selection. "
+3 WRITE !,"Choose a number between 1 and "_VALMCNT
End DoDot:1
QUIT
+4 IF '$DATA(^TMP("GMRCR",$JOB,"DT",NUM,1))
Begin DoDot:1
+5 DO EXAC^GMRCADC("The displayed item is not selectable")
End DoDot:1
QUIT
+6 IF $DATA(GMRCMEDR)
DO RESETIT(GMRCMEDR)
+7 SET GMRCMEDR=NUM
+8 DO CNTRL^VALM10(NUM,1,80,IORVON,IORVOFF)
+9 DO WRITE^VALM10(NUM)
+10 SET VALMBCK=""
+11 QUIT
RESETIT(NUM) ;return prev. selected number to normal video
+1 DO CNTRL^VALM10(NUM,1,80,IOINORM,IOINORM)
+2 DO WRITE^VALM10(NUM)
+3 SET VALMBCK=""
KILL GMRCSEL
+4 QUIT
RESULTS(ROOT,GMRCDFN) ;get list of results from Medicine
+1 ; ROOT = "MCAR(691","MCAR(691.5" etc. (global root w/o comma)
+2 ; return list formatted in ^TMP("GMRCMC",$J
+3 NEW S5,CNT,REC
+4 KILL ^TMP("GMRCMC",$JOB)
+5 SET S5=ROOT
DO EN^MCARPS2(GMRCDFN)
+6 IF '$DATA(^TMP("OR",$JOB,"MCAR"))
Begin DoDot:1
+7 ;D EXAC^GMRCADC("No results found for"_$P(ROOT,U,2))
End DoDot:1
QUIT
+8 SET CNT=1
SET REC=0
+9 FOR
SET REC=$ORDER(^TMP("OR",$JOB,"MCAR","OT",REC))
if 'REC
QUIT
Begin DoDot:1
+10 NEW MCDATA,DATA,ONEDATA
+11 SET MCDATA=^TMP("OR",$JOB,"MCAR","OT",REC)
SET DATA=""
+12 if $DATA(^GMR(123,"R",$PIECE(MCDATA,U,2)_";"_ROOT_","))
QUIT
+13 if $$SCRNDRFT($PIECE(MCDATA,U,2),$PIECE(ROOT,"(",2))
QUIT
+14 SET DATA=$$SETSTR^VALM1(CNT,DATA,2,$LENGTH(REC))
+15 SET DATA=$$SETSTR^VALM1($PIECE(MCDATA,U),DATA,6,23)
+16 SET DATA=$$SETSTR^VALM1($PIECE(MCDATA,U,6),DATA,30,$LENGTH($PIECE(MCDATA,U,6)))
+17 SET DATA=$$SETSTR^VALM1($PIECE(MCDATA,U,7),DATA,50,$LENGTH($PIECE(MCDATA,U,7)))
+18 SET ^TMP("GMRCR",$JOB,"DT",CNT,0)=DATA
+19 ;S ONEDATA=REC_U_$P(MCDATA,U,2)_";"_ROOT_","_U_$P(MCDATA,U,3,5)
+20 ;S ONEDATA=ONEDATA_U_$P(MCDATA,U,11)
+21 SET ONEDATA=$PIECE(MCDATA,U,2)_";"_ROOT_","
+22 SET ^TMP("GMRCR",$JOB,"DT",CNT,1)=ONEDATA
+23 SET CNT=CNT+1
End DoDot:1
+24 KILL ^TMP("OR",$JOB,"MCAR")
+25 QUIT
PHDR ;set protocols into actions
+1 SET VALMSG=$$CJ^XLFSTR("Select action or item number ?? for help",80)
+2 SET XQORM("M")=3
+3 DO SHOW^VALM
+4 SET XQORM("#")=$ORDER(^ORD(101,"B","GMRCACT SELECT MED RESULT",0))_"^1:"_VALMCNT
+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","AR")=$ORDER(^ORD(101,"B","GMRCACT ASSOCIATE RESULTS",0))_"^1"
+10 SET XQORM("KEY","DR")=$ORDER(^ORD(101,"B","GMRCACT DISPLAY MED RESULT",0))_"^1"
+11 QUIT
+12 ;
SELECT(CNT) ;grab an item from list
+1 NEW DIR,DUOUT,DTOUT,DIRUT,X,Y
+2 SET DIR(0)="NO^1:"_CNT
SET DIR("A")="Select item"
+3 DO ^DIR
IF $DATA(DIRUT)
QUIT 0
+4 QUIT +Y
+5 ;
DISPRES(ITEM) ;
+1 ; no result there
IF '+$GET(^TMP("GMRCR",$JOB,"DT",1,1))
Begin DoDot:1
+2 DO EXAC^GMRCADC("There are no results to display")
End DoDot:1
QUIT
+3 NEW GMRCDFN
+4 IF '$GET(ITEM)
IF '$GET(GMRCMEDR)
Begin DoDot:1
+5 SET ITEM=$$SELECT(VALMCNT)
+6 DO SET(ITEM)
End DoDot:1
if 'ITEM
QUIT
+7 IF $GET(GMRCMEDR)
SET ITEM=GMRCMEDR
+8 NEW I,GMRCRES,GMRCDFN,GMRCVTIT
+9 SET GMRCRES=$GET(^TMP("GMRCR",$JOB,"DT",ITEM,1))
+10 if '$LENGTH(GMRCRES)
QUIT
+11 MERGE ^TMP("GMRCR",$JOB,"DTSV")=^TMP("GMRCR",$JOB,"DT")
+12 KILL ^TMP("GMRCR",$JOB,"DT")
+13 SET GMRCDFN=$GET(DFN)
+14 DO START^ORWRP(80,"EN^MCAPI(GMRCRES)")
+15 IF '$DATA(^TMP("ORDATA",$JOB,1))
Begin DoDot:1
+16 SET ^TMP("GMRCR",$JOB,"DTLIST",1,0)="Unable to locate result"
End DoDot:1
QUIT
+17 SET I=0
FOR
SET I=$ORDER(^TMP("ORDATA",$JOB,1,I))
if 'I
QUIT
Begin DoDot:1
+18 SET ^TMP("GMRCR",$JOB,"DTLIST",I,0)=^TMP("ORDATA",$JOB,1,I)
End DoDot:1
+19 ; clean up from OR WORKSTATION
KILL ^TMP("ORDATA",$JOB)
+20 SET DFN=$SELECT(+GMRCDFN:GMRCDFN,$GET(ORVP):+ORVP,1:0)
+21 SET GMRCVTIT="Medicine Result Display"
+22 SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DTLIST",999999),-1)
+23 DO EN^VALM("GMRC DETAILED DISPLAY")
+24 MERGE ^TMP("GMRCR",$JOB,"DT")=^TMP("GMRCR",$JOB,"DTSV")
+25 KILL ^TMP("GMRCR",$JOB,"DTSV")
+26 SET VALMBCK="R"
SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DT",999999),-1)
+27 QUIT
+28 ;
AR(ITEM) ;associate specific result and complete consult
+1 ; no result there
IF '+$GET(^TMP("GMRCR",$JOB,"DT",1,1))
Begin DoDot:1
+2 DO EXAC^GMRCADC("There are no results to associate")
End DoDot:1
QUIT
+3 NEW DIR,X,Y,RESTXT,RESULT
+4 IF '$GET(ITEM)
IF '$GET(GMRCMEDR)
Begin DoDot:1
+5 SET ITEM=$$SELECT(VALMCNT)
+6 DO SET(ITEM)
End DoDot:1
if 'ITEM
QUIT
+7 IF $GET(GMRCMEDR)
SET ITEM=GMRCMEDR
+8 DO FULL^VALM1
+9 SET RESTXT=$EXTRACT(^TMP("GMRCR",$JOB,"DT",ITEM,0),6,80)
+10 SET RESULT=^TMP("GMRCR",$JOB,"DT",ITEM,1)
if '+RESULT
QUIT
+11 IF $DATA(^GMR(123,"R",RESULT))
Begin DoDot:1
+12 DO EXAC^GMRCADC("This result is already associated with a procedure.")
End DoDot:1
QUIT
+13 SET DIR(0)="YA"
SET DIR("B")="NO"
+14 SET DIR("A",1)=""
SET DIR("A",2)=" "_RESTXT
SET DIR("A",3)=""
+15 SET DIR("A")="Are you sure you want to associate this result? "
+16 DO ^DIR
IF Y<1
QUIT
+17 DO MEDCOMP(GMRCO,RESULT,$$NOW^XLFDT,DUZ)
+18 QUIT
MEDCOMP(GMRCDA,GMRCRSLT,GMRCAD,GMRCORNP,GMRCALRT) ;add medicine result
+1 ; update status and send alerts
+2 ; Input:
+3 ; GMRCDA - ien from file 123
+4 ; GMRCRSLT - medicine result in var ptr form (e.g. "19;MCAR(691.5,")
+5 ; GMRCAD - FM date/time of action (optional)
+6 ; GMRCORNP - DUZ of person taking action
+7 ; GMRCALRT - array of users to receive alert (optional)
+8 ;
+9 IF '$DATA(GMRCDA)!'$DATA(GMRCRSLT)
QUIT
+10 NEW GMRCO,GMRCSTS,GMRCA,GMRCDR,GMRCTYP,MSG
+11 SET GMRCO=GMRCDA
SET GMRCA=10
SET GMRCSTS=2
+12 SET GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;11////^S X=GMRCRSLT"
+13 DO STATUS^GMRCP
+14 IF $DATA(GMRCAD)
DO AUDIT^GMRCP
+15 IF '$DATA(GMRCAD)
DO AUDIT0^GMRCP
+16 DO ADDRSLT^GMRCTIUA(GMRCDA,GMRCRSLT)
+17 SET MSG="NEW RESULT ASSOCIATED"
SET GMRCDFN=$PIECE(^GMR(123,GMRCO,0),U,2)
+18 DO MSG^GMRCP(GMRCDFN,MSG,GMRCDA,23,.GMRCALRT,0)
+19 SET GMRCTYP=$PIECE(^GMR(123,+GMRCDA,0),U,17)
+20 DO EN^GMRCHL7(GMRCDFN,GMRCDA,GMRCTYP,"","RE",$GET(GMRCORNP),"")
+21 QUIT
REFRESH(GMRCIEN) ;update list of available results
+1 NEW MCROOT,MCPROC,GMRCPROC
+2 IF $GET(GMRCMEDR)
DO RESETIT(GMRCMEDR)
+3 KILL ^TMP("GMRCR",$JOB,"DT"),GMRCMEDR
+4 SET GMRCPROC=$PIECE(^GMR(123,GMRCIEN,0),"^",8)
+5 SET MCROOT=$$GET1^DIQ(697.2,+$PIECE(^GMR(123.3,+GMRCPROC,0),U,5),1)
+6 DO RESULTS^GMRCMED(MCROOT,$PIECE(^GMR(123,+GMRCIEN,0),U,2))
+7 IF '$ORDER(^TMP("GMRCR",$JOB,"DT",0))
Begin DoDot:1
+8 SET ^TMP("GMRCR",$JOB,"DT",1,0)="No further results to associate"
End DoDot:1
+9 SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DT",""),-1)
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
SCRNDRFT(GMRCMCDA,GMRCMCFL) ;screen out draft or marked for del med results
+1 ; Input:
+2 ; GMRCDA - ien from a MEDICINE file
+3 ; GMRCMCFL - file # from MEDICINE (e.g. 691, 691.5, 699 etc.)
+4 ; Output: Boolean 1=screen it out 0=include it
+5 ;
+6 NEW GMRCMCST,GMRCMFD
+7 IF '$DATA(GMRCMCDA)!('$DATA(GMRCMCFL))
QUIT 0
+8 ;get release code
SET GMRCMCST=$$GET1^DIQ(GMRCMCFL,GMRCMCDA,1506,"I")
+9 ;no D or PD
SET GMRCMCST=$SELECT(GMRCMCST="D":0,GMRCMCST="PD":0,1:1)
+10 ;marked for del?
SET GMRCMFD=$$GET1^DIQ(GMRCMCFL,GMRCMCDA,1511,"I")
+11 ;marked for del
IF GMRCMFD=1
QUIT 1
+12 ;screen out draft or prob draft
IF GMRCMCST=0
QUIT 1
+13 QUIT 0
