GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
AR ;Associate results with request
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
I '$D(GMRCSEL) D SEL^GMRCA2 I $D(DTOUT)!$D(DIROUT) S GMRCQIT="" Q
I 'GMRCSEL G END
S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0)),GMRC(0)=^GMR(123,GMRCO,0)
I $P(GMRC(0),"^",12)=1 W !!,"THIS ORDER HAS BEEN DISCONTINUED, PLEASE SELECT OR ADD ANOTHER ORDER!",!! G END
S GMRCQIT="" Q
ARMED ;Entry to associate results with a consult/request
N GMRCQIT,GMRCQUT,GMRCPROC,GMRCSR,MCROOT,MCFILE,Y
I '$$VERSION^XPDUTL("MC") D Q
. N GMRCMSG
. S GMRCMSG="Medicine Package Not Installed. Can't Associate Results."
. D EXAC^GMRCADC(GMRCMSG)
I $$VERSION^XPDUTL("MC")'>2.0 D Q
. N GMRCMSG
. S GMRCMSG="**Version 2.2 of Medicine required to associate results with Consults**"
. D EXAC^GMRCADC(GMRCMSG)
. S GMRCQUT=1
I $D(XQY0),$E(XQY0,1,2)="MC" G AR
I '$D(GMRCO) D SEL^GMRCA2 I 'GMRCSEL G END
I $D(VALM) D FULL^VALM1
I '$D(GMRCO) S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
S GMRC(0)=^GMR(123,GMRCO,0)
S GMRCPROC=$P(GMRC(0),"^",8)
I GMRCPROC="" D G END
. S GMRCMSG="No Procedure was ordered - Cannot Associate Results."
. D EXAC^GMRCADC(GMRCMSG) S GMRCQIT=1
I '$P(^GMR(123.3,+GMRCPROC,0),U,5) D I $G(GMRCQIT)=1 G END
. D EXAC^GMRCADC("This procedure not configured for Medicine Resulting")
. S GMRCQIT=1
I $P(GMRC(0),"^",12)=1 D G END
. S GMRCMSG="THIS ORDER HAS BEEN DISCONTINUED!"
. D EXAC^GMRCADC(GMRCMSG) S GMRCQUT=1
I +$P(GMRC(0),"^",15),$P(GMRC(0),U,15)["MCAR" D
. S GMRCSR=$P(GMRC(0),"^",15)
. S GMRCSR=U_$P(GMRCSR,";",2)_$P(GMRCSR,";")_",0)"
. I '$D(@GMRCSR) D I $G(GMRCQIT)=1 Q
.. S GMRCMSG="This request is currently associated with results "
.. S GMRCMSG=GMRCMSG_"no longer available" D EXAC^GMRCADC(GMRCMSG),END
.. S GMRCQIT=1
.S X=$P(@GMRCSR,"^",1) D REGDTM^GMRCU S X1=X
.S X=$P(^GMR(123,GMRCO,0),"^",7) D REGDTM^GMRCU
.W !," Results entered on "_X1_" are associated "
.W !," with this request ordered on "_X
. S DIR(0)="YA",DIR("A")="Would you like to continue? "
. S DIR("B")="No" D ^DIR I Y<1 S GMRCQIT=1 Q
. Q
I $G(GMRCQIT)=1 Q
S MCROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,+GMRCPROC,0),U,5),1)
D RESULTS^GMRCMED(MCROOT,$P(^GMR(123,+GMRCO,0),U,2))
I $D(^TMP("GMRCR",$J,"DT")) D EN^GMRCMER S VALMBCK="R",GMRCQIT=1
I '$D(^TMP("GMRCR",$J,"DT"))&'($G(GMRCQIT)) D
. N MSG
. S MSG="No results are available to associate with this request."
. D EXAC^GMRCADC(MSG)
Q
LKUP ;look up on procedure file using "C" cross-reference
N Y,DIC
S GMRCDIC="^"_GMRCGL_",""C"","_DFN_")" I '$D(@GMRCDIC) S GMRCMSG="No "_GMRCPRNM_" results available for "_$P(^DPT(DFN,0),"^") D EXAC^GMRCADC(GMRCMSG) G END
S DIC="^"_GMRCGL_",",DIC(0)="XEZ",D="C",X=$P(^DPT(DFN,0),"^"),DIC("S")="I $P(^(0),U,2)=DFN" W !,"Results for "_$P(^DPT(DFN,0),"^")
D MIX^DIC1 G:+Y<0 END
S GMRCSR=+Y_";"_GMRCGL_",",GMRCSRDT=Y(0,0)
N GMRCEND S GMRCEND=0 W ! S DIR(0)="Y",DIR("A")="Do you want to review these results first",DIR("B")="Y" D ^DIR K DIR I Y D G:GMRCEND END
.W @IOF S GMRCSRS=GMRCSR D AREN^GMRCSLM3(GMRCO,GMRCSR),EN^GMRCMER S GMRCSR=GMRCSRS
.I GMRCCT=1 S GMRCEND=1 Q
.N DIR,DIROUT,DTOUT,DUOUT
.W !! S DIR(0)="Y",DIR("A")="Are these the right results to be associated with the selected request",DIR("B")="N" D ^DIR K DIR S:$D(DIROUT)!$D(DTOUT)!(X="^") GMRCEND=1
.I Y=0 K GMRCSR S GMRCEND=1
I GMRCEND K GMRCEND G END
I '$D(GMRCSR) K GMRCEND W ! G LKUP
I '+GMRCSR G END
ORSTS ;Check if status needs update to complete
N ORSTS
I $P(GMRC(0),"^",12)=2 W !,"This request is already completed, no updating performed for this request",!,"Press the <ENTER> key to EXIT " R X:DTIME G END
W ! S DIR(0)="Y",DIR("A")="Shall I update the order status to complete",DIR("B")="N",DIR("?")="Type 'Y' for 'YES' or 'N' for 'NO' and press <ENTER> key." D ^DIR K DIR I $D(DTOUT)!$D(DIROUT)!$D(DUOUT) G END
S ORSTS=$S(Y:2,1:9)
I $P(^GMR(123,GMRCO,0),"^",12)=ORSTS&(+$P(^GMR(123,GMRCO,0),"^",15)) G END
S GETPROV="Clinician responsible for results" D GETPROV^GMRCAU I '$D(GMRCORNP) S GMRCQIT="" G END
S GMRCSVSS=GMRCSVCN D RESULT^GMRCR S GMRCSS=GMRCSVSS K GMRCSVSS,ORIFN
S GMRCVP=$O(^ORD(101,"B","GMRCR "_GMRCPROC,0)) I GMRCVP]"" S GMRCVP=GMRCVP_";ORD(101," D AD^GMRCSLM1,INIT^GMRCSLM
END ;
K ORIFN,GMRCO,GMRCEND,GMRCGL,GMRCDIC,GMRCMSG,GMRCVP,DIC,D,GMRCSR,GMRCSRDT,GMRCSRS,GMRCTM,GMRCBM,X,X1,GETPROV
K GMRCO,GMRC(0),GMRCSR,MCFILE,MCPROC,GMRCPROC,GMRCPRNM
I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCAR 4607 printed Sep 02, 2024@18:30:29 Page 2
GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
AR ;Associate results with request
+1 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+2 IF '$DATA(GMRCSEL)
DO SEL^GMRCA2
IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRCQIT=""
QUIT
+3 IF 'GMRCSEL
GOTO END
+4 SET GMRCO=$ORDER(^TMP("GMRCR",$JOB,"CS","AD",GMRCSEL,GMRCSEL,0))
SET GMRC(0)=^GMR(123,GMRCO,0)
+5 IF $PIECE(GMRC(0),"^",12)=1
WRITE !!,"THIS ORDER HAS BEEN DISCONTINUED, PLEASE SELECT OR ADD ANOTHER ORDER!",!!
GOTO END
+6 SET GMRCQIT=""
QUIT
ARMED ;Entry to associate results with a consult/request
+1 NEW GMRCQIT,GMRCQUT,GMRCPROC,GMRCSR,MCROOT,MCFILE,Y
+2 IF '$$VERSION^XPDUTL("MC")
Begin DoDot:1
+3 NEW GMRCMSG
+4 SET GMRCMSG="Medicine Package Not Installed. Can't Associate Results."
+5 DO EXAC^GMRCADC(GMRCMSG)
End DoDot:1
QUIT
+6 IF $$VERSION^XPDUTL("MC")'>2.0
Begin DoDot:1
+7 NEW GMRCMSG
+8 SET GMRCMSG="**Version 2.2 of Medicine required to associate results with Consults**"
+9 DO EXAC^GMRCADC(GMRCMSG)
+10 SET GMRCQUT=1
End DoDot:1
QUIT
+11 IF $DATA(XQY0)
IF $EXTRACT(XQY0,1,2)="MC"
GOTO AR
+12 IF '$DATA(GMRCO)
DO SEL^GMRCA2
IF 'GMRCSEL
GOTO END
+13 IF $DATA(VALM)
DO FULL^VALM1
+14 IF '$DATA(GMRCO)
SET GMRCO=$ORDER(^TMP("GMRCR",$JOB,"CS","AD",GMRCSEL,GMRCSEL,0))
+15 SET GMRC(0)=^GMR(123,GMRCO,0)
+16 SET GMRCPROC=$PIECE(GMRC(0),"^",8)
+17 IF GMRCPROC=""
Begin DoDot:1
+18 SET GMRCMSG="No Procedure was ordered - Cannot Associate Results."
+19 DO EXAC^GMRCADC(GMRCMSG)
SET GMRCQIT=1
End DoDot:1
GOTO END
+20 IF '$PIECE(^GMR(123.3,+GMRCPROC,0),U,5)
Begin DoDot:1
+21 DO EXAC^GMRCADC("This procedure not configured for Medicine Resulting")
+22 SET GMRCQIT=1
End DoDot:1
IF $GET(GMRCQIT)=1
GOTO END
+23 IF $PIECE(GMRC(0),"^",12)=1
Begin DoDot:1
+24 SET GMRCMSG="THIS ORDER HAS BEEN DISCONTINUED!"
+25 DO EXAC^GMRCADC(GMRCMSG)
SET GMRCQUT=1
End DoDot:1
GOTO END
+26 IF +$PIECE(GMRC(0),"^",15)
IF $PIECE(GMRC(0),U,15)["MCAR"
Begin DoDot:1
+27 SET GMRCSR=$PIECE(GMRC(0),"^",15)
+28 SET GMRCSR=U_$PIECE(GMRCSR,";",2)_$PIECE(GMRCSR,";")_",0)"
+29 IF '$DATA(@GMRCSR)
Begin DoDot:2
+30 SET GMRCMSG="This request is currently associated with results "
+31 SET GMRCMSG=GMRCMSG_"no longer available"
DO EXAC^GMRCADC(GMRCMSG)
DO END
+32 SET GMRCQIT=1
End DoDot:2
IF $GET(GMRCQIT)=1
QUIT
+33 SET X=$PIECE(@GMRCSR,"^",1)
DO REGDTM^GMRCU
SET X1=X
+34 SET X=$PIECE(^GMR(123,GMRCO,0),"^",7)
DO REGDTM^GMRCU
+35 WRITE !," Results entered on "_X1_" are associated "
+36 WRITE !," with this request ordered on "_X
+37 SET DIR(0)="YA"
SET DIR("A")="Would you like to continue? "
+38 SET DIR("B")="No"
DO ^DIR
IF Y<1
SET GMRCQIT=1
QUIT
+39 QUIT
End DoDot:1
+40 IF $GET(GMRCQIT)=1
QUIT
+41 SET MCROOT=$$GET1^DIQ(697.2,+$PIECE(^GMR(123.3,+GMRCPROC,0),U,5),1)
+42 DO RESULTS^GMRCMED(MCROOT,$PIECE(^GMR(123,+GMRCO,0),U,2))
+43 IF $DATA(^TMP("GMRCR",$JOB,"DT"))
DO EN^GMRCMER
SET VALMBCK="R"
SET GMRCQIT=1
+44 IF '$DATA(^TMP("GMRCR",$JOB,"DT"))&'($GET(GMRCQIT))
Begin DoDot:1
+45 NEW MSG
+46 SET MSG="No results are available to associate with this request."
+47 DO EXAC^GMRCADC(MSG)
End DoDot:1
+48 QUIT
LKUP ;look up on procedure file using "C" cross-reference
+1 NEW Y,DIC
+2 SET GMRCDIC="^"_GMRCGL_",""C"","_DFN_")"
IF '$DATA(@GMRCDIC)
SET GMRCMSG="No "_GMRCPRNM_" results available for "_$PIECE(^DPT(DFN,0),"^")
DO EXAC^GMRCADC(GMRCMSG)
GOTO END
+3 SET DIC="^"_GMRCGL_","
SET DIC(0)="XEZ"
SET D="C"
SET X=$PIECE(^DPT(DFN,0),"^")
SET DIC("S")="I $P(^(0),U,2)=DFN"
WRITE !,"Results for "_$PIECE(^DPT(DFN,0),"^")
+4 DO MIX^DIC1
if +Y<0
GOTO END
+5 SET GMRCSR=+Y_";"_GMRCGL_","
SET GMRCSRDT=Y(0,0)
+6 NEW GMRCEND
SET GMRCEND=0
WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to review these results first"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF Y
Begin DoDot:1
+7 WRITE @IOF
SET GMRCSRS=GMRCSR
DO AREN^GMRCSLM3(GMRCO,GMRCSR)
DO EN^GMRCMER
SET GMRCSR=GMRCSRS
+8 IF GMRCCT=1
SET GMRCEND=1
QUIT
+9 NEW DIR,DIROUT,DTOUT,DUOUT
+10 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Are these the right results to be associated with the selected request"
SET DIR("B")="N"
DO ^DIR
KILL DIR
if $DATA(DIROUT)!$DATA(DTOUT)!(X="^")
SET GMRCEND=1
+11 IF Y=0
KILL GMRCSR
SET GMRCEND=1
End DoDot:1
if GMRCEND
GOTO END
+12 IF GMRCEND
KILL GMRCEND
GOTO END
+13 IF '$DATA(GMRCSR)
KILL GMRCEND
WRITE !
GOTO LKUP
+14 IF '+GMRCSR
GOTO END
ORSTS ;Check if status needs update to complete
+1 NEW ORSTS
+2 IF $PIECE(GMRC(0),"^",12)=2
WRITE !,"This request is already completed, no updating performed for this request",!,"Press the <ENTER> key to EXIT "
READ X:DTIME
GOTO END
+3 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Shall I update the order status to complete"
SET DIR("B")="N"
SET DIR("?")="Type 'Y' for 'YES' or 'N' for 'NO' and press <ENTER> key."
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
GOTO END
+4 SET ORSTS=$SELECT(Y:2,1:9)
+5 IF $PIECE(^GMR(123,GMRCO,0),"^",12)=ORSTS&(+$PIECE(^GMR(123,GMRCO,0),"^",15))
GOTO END
+6 SET GETPROV="Clinician responsible for results"
DO GETPROV^GMRCAU
IF '$DATA(GMRCORNP)
SET GMRCQIT=""
GOTO END
+7 SET GMRCSVSS=GMRCSVCN
DO RESULT^GMRCR
SET GMRCSS=GMRCSVSS
KILL GMRCSVSS,ORIFN
+8 SET GMRCVP=$ORDER(^ORD(101,"B","GMRCR "_GMRCPROC,0))
IF GMRCVP]""
SET GMRCVP=GMRCVP_";ORD(101,"
DO AD^GMRCSLM1
DO INIT^GMRCSLM
END ;
+1 KILL ORIFN,GMRCO,GMRCEND,GMRCGL,GMRCDIC,GMRCMSG,GMRCVP,DIC,D,GMRCSR,GMRCSRDT,GMRCSRS,GMRCTM,GMRCBM,X,X1,GETPROV
+2 KILL GMRCO,GMRC(0),GMRCSR,MCFILE,MCPROC,GMRCPROC,GMRCPRNM
+3 IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRCQIT=""
+4 QUIT
