Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCAR

GMRCAR.m

Go to the documentation of this file.
  1. GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
  1. ;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
  1. AR ;Associate results with request
  1. I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
  1. I '$D(GMRCSEL) D SEL^GMRCA2 I $D(DTOUT)!$D(DIROUT) S GMRCQIT="" Q
  1. I 'GMRCSEL G END
  1. S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0)),GMRC(0)=^GMR(123,GMRCO,0)
  1. I $P(GMRC(0),"^",12)=1 W !!,"THIS ORDER HAS BEEN DISCONTINUED, PLEASE SELECT OR ADD ANOTHER ORDER!",!! G END
  1. S GMRCQIT="" Q
  1. ARMED ;Entry to associate results with a consult/request
  1. N GMRCQIT,GMRCQUT,GMRCPROC,GMRCSR,MCROOT,MCFILE,Y
  1. I '$$VERSION^XPDUTL("MC") D Q
  1. . N GMRCMSG
  1. . S GMRCMSG="Medicine Package Not Installed. Can't Associate Results."
  1. . D EXAC^GMRCADC(GMRCMSG)
  1. I $$VERSION^XPDUTL("MC")'>2.0 D Q
  1. . N GMRCMSG
  1. . S GMRCMSG="**Version 2.2 of Medicine required to associate results with Consults**"
  1. . D EXAC^GMRCADC(GMRCMSG)
  1. . S GMRCQUT=1
  1. I $D(XQY0),$E(XQY0,1,2)="MC" G AR
  1. I '$D(GMRCO) D SEL^GMRCA2 I 'GMRCSEL G END
  1. I $D(VALM) D FULL^VALM1
  1. I '$D(GMRCO) S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
  1. S GMRC(0)=^GMR(123,GMRCO,0)
  1. S GMRCPROC=$P(GMRC(0),"^",8)
  1. I GMRCPROC="" D G END
  1. . S GMRCMSG="No Procedure was ordered - Cannot Associate Results."
  1. . D EXAC^GMRCADC(GMRCMSG) S GMRCQIT=1
  1. I '$P(^GMR(123.3,+GMRCPROC,0),U,5) D I $G(GMRCQIT)=1 G END
  1. . D EXAC^GMRCADC("This procedure not configured for Medicine Resulting")
  1. . S GMRCQIT=1
  1. I $P(GMRC(0),"^",12)=1 D G END
  1. . S GMRCMSG="THIS ORDER HAS BEEN DISCONTINUED!"
  1. . D EXAC^GMRCADC(GMRCMSG) S GMRCQUT=1
  1. I +$P(GMRC(0),"^",15),$P(GMRC(0),U,15)["MCAR" D
  1. . S GMRCSR=$P(GMRC(0),"^",15)
  1. . S GMRCSR=U_$P(GMRCSR,";",2)_$P(GMRCSR,";")_",0)"
  1. . I '$D(@GMRCSR) D I $G(GMRCQIT)=1 Q
  1. .. S GMRCMSG="This request is currently associated with results "
  1. .. S GMRCMSG=GMRCMSG_"no longer available" D EXAC^GMRCADC(GMRCMSG),END
  1. .. S GMRCQIT=1
  1. .S X=$P(@GMRCSR,"^",1) D REGDTM^GMRCU S X1=X
  1. .S X=$P(^GMR(123,GMRCO,0),"^",7) D REGDTM^GMRCU
  1. .W !," Results entered on "_X1_" are associated "
  1. .W !," with this request ordered on "_X
  1. . S DIR(0)="YA",DIR("A")="Would you like to continue? "
  1. . S DIR("B")="No" D ^DIR I Y<1 S GMRCQIT=1 Q
  1. . Q
  1. I $G(GMRCQIT)=1 Q
  1. S MCROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,+GMRCPROC,0),U,5),1)
  1. D RESULTS^GMRCMED(MCROOT,$P(^GMR(123,+GMRCO,0),U,2))
  1. I $D(^TMP("GMRCR",$J,"DT")) D EN^GMRCMER S VALMBCK="R",GMRCQIT=1
  1. I '$D(^TMP("GMRCR",$J,"DT"))&'($G(GMRCQIT)) D
  1. . N MSG
  1. . S MSG="No results are available to associate with this request."
  1. . D EXAC^GMRCADC(MSG)
  1. Q
  1. LKUP ;look up on procedure file using "C" cross-reference
  1. N Y,DIC
  1. 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
  1. 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),"^")
  1. D MIX^DIC1 G:+Y<0 END
  1. S GMRCSR=+Y_";"_GMRCGL_",",GMRCSRDT=Y(0,0)
  1. 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
  1. .W @IOF S GMRCSRS=GMRCSR D AREN^GMRCSLM3(GMRCO,GMRCSR),EN^GMRCMER S GMRCSR=GMRCSRS
  1. .I GMRCCT=1 S GMRCEND=1 Q
  1. .N DIR,DIROUT,DTOUT,DUOUT
  1. .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
  1. .I Y=0 K GMRCSR S GMRCEND=1
  1. I GMRCEND K GMRCEND G END
  1. I '$D(GMRCSR) K GMRCEND W ! G LKUP
  1. I '+GMRCSR G END
  1. ORSTS ;Check if status needs update to complete
  1. N ORSTS
  1. 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
  1. 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
  1. S ORSTS=$S(Y:2,1:9)
  1. I $P(^GMR(123,GMRCO,0),"^",12)=ORSTS&(+$P(^GMR(123,GMRCO,0),"^",15)) G END
  1. S GETPROV="Clinician responsible for results" D GETPROV^GMRCAU I '$D(GMRCORNP) S GMRCQIT="" G END
  1. S GMRCSVSS=GMRCSVCN D RESULT^GMRCR S GMRCSS=GMRCSVSS K GMRCSVSS,ORIFN
  1. S GMRCVP=$O(^ORD(101,"B","GMRCR "_GMRCPROC,0)) I GMRCVP]"" S GMRCVP=GMRCVP_";ORD(101," D AD^GMRCSLM1,INIT^GMRCSLM
  1. END ;
  1. K ORIFN,GMRCO,GMRCEND,GMRCGL,GMRCDIC,GMRCMSG,GMRCVP,DIC,D,GMRCSR,GMRCSRDT,GMRCSRS,GMRCTM,GMRCBM,X,X1,GETPROV
  1. K GMRCO,GMRC(0),GMRCSR,MCFILE,MCPROC,GMRCPROC,GMRCPRNM
  1. I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
  1. Q