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

GMRCR.m

Go to the documentation of this file.
  1. GMRCR ;SLC/DLT - Driver for reviewing patient consult/requests - Used by Medicine Package to link Consults to Medicine results ;9/18/98 16:26
  1. ;;3.0;CONSULT/REQUEST TRACKING;**1,5,46**;DEC 27, 1997;Build 23
  1. EN ;Entry point for medicine results entry by procedure or consult type
  1. ;Required variables:
  1. ; GMRCPRNM = name of procedure file with results.
  1. ; DFN = patient file (2) ien
  1. ;Optional variables:
  1. ; GMRCSR = variable pointer for results
  1. ; ORSTS = order status
  1. ; GMRCI = 0 or undefined, assume interactive
  1. ; 1, assume non-interactive - not operational currently
  1. ;Returned variables:
  1. ; ORIFN = Pointer to the consult order in file 100
  1. ; GMRCO = Pointer to the Request/Consultation entry in file 123.5
  1. ;
  1. K DTOUT,DUOUT,ORIFN,GMRCO,GMRCX
  1. I '$D(GMRCPNM) D DEM^GMRCU
  1. I $D(GMRCPRNM) S GMRC=$O(^ORD(101,"B","GMRCR "_GMRCPRNM,0)),GMRCTYPE="GMRCOR REQUEST"
  1. E I $D(GMRCPR) S GMRC=GMRCPR,GMRCTYPE="GMRCOR REQUEST"
  1. I $D(GMRCCT) S GMRC=GMRCCT,GMRCTYPE="GMRCOR CONSULT"
  1. I $D(GMRC)=1!($D(GMRC)=11),+GMRC D
  1. .S GMRCVP=GMRC_";ORD(101,",GMRCNM=$S($D(^ORD(101,GMRC,0)):$P(^(0),"^",2),1:"")
  1. .S GMRCSS=$P($G(^ORD(101,+GMRCVP,5)),"^"),GMRCSS=+GMRCSS
  1. EN1 ;Entry point for
  1. Q I 'GMRCSS D ASRV^GMRCASV D Q:GMRCEND S GMRCSS=+GMRCDG I 'GMRCDG S GMRCEND=1 K GMRCSS Q
  1. .I $D(DTOUT)!($D(DIROUT)) S GMRCEND=1 K DTOUT,DIROUT,DIRUT,DUOUT Q
  1. .Q
  1. E S GMRCDG=GMRCSS D SERV1^GMRCASV
  1. I '$D(ORTKG) S ORTKG=$$PACKAGE I ORTKG="" S GMRCMSG="Missing package entry for CONSULT/REQUEST TRACKING" D EXAC^GMRCADC(GMRCMSG) K GMRCMSG S GMRCEND=1 Q
  1. ;old code? D TEAM^GMRCASV
  1. S GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
  1. ;old codeN GMRCQIT
  1. ;old code? S ORVP=DFN_";DPT(",GMRCGRP=0
  1. ;old code? K ^TMP("GMRCR",$J)
  1. K GMRCOER,GMRCQUT
  1. S GMRCEN=1
  1. D EN^GMRCMENU ; used to be D EN^GMRCACTM
  1. S GMRCOER=0
  1. D AD^GMRCSLM1 ; used to be D AD^GMRCRA
  1. D EN^VALM("GMRC CONSULT TRACKING")
  1. D KILL
  1. Q
  1. KILL ; Kill variables, but don't kill GMRCO and ORIFN if from MC option
  1. ;K VALMCNT,VALMBCK,VALMPGE
  1. ;K ^TMP("GMRCR",$J,"CS"),^TMP("GMRCS",$J)
  1. K X,Y,Z,DTOUT,DUOUT,DIROUT
  1. K GMRC,GMRCA,GMRCACT,GMRCACTM,GMRCAGE,GMRCCT,GMRCCTX,GMRCDG,GMRCDGT
  1. K GMRCDOB,GMRCDTM,GMRCGRP,GMRCH,GMRCHDR,GMRCIFN,GMRCLFG,GMRCNM,GMRCNPG
  1. K GMRCPNM,GMRCRB,GMRCWARD,GMRCSN,GMRCRPG,GMRCNPG,GMRCTITL,GMRCX,GMRCHDR,GMRCH,GMRCDTM
  1. K GMRCSTS,GMRCTYPE,GMRCVP,GMRCEND,GMRCTO,GMRCURG,GMRCL,GMRCDT,GMRCDIC
  1. K VA,VAIN,VAINDT,VADM,VAEL,VAPA,VAERR,VAROOT
  1. K O,OREND,ORINDX,ORNS,POP,SEX,W,XQORSPEW
  1. I $D(XQY0),$E(XQY0,1,2)="MC" S:'$D(GMRCO) (ORIFN,GMRCO)="" Q
  1. K ORIFN,GMRCO,GMRCSR
  1. Q
  1. RESULT ;Entry point to set up variable pointer to results and update OE/RR status
  1. Q
  1. Q:'$D(GMRCSR) Q:'$D(GMRCO) S (GMRCSS,GMRCSSNM,GMRCNM,GMRC,GMRCVP)=""
  1. S GMRCOM=0,GMR(0)=$S($D(^GMR(123,+GMRCO,0)):^(0),1:""),GMRCSS=$P(GMR(0),"^",5) I GMRCSS,$D(^GMR(123.5,GMRCSS,0)) S GMRCSSNM=$S($L($P(^GMR(123.5,GMRCSS,0),"^",9)):$P(^(0),"^",9),1:$P(^(0),"^"))
  1. S GMRCVP=$P(GMR(0),"^",8) I +GMRCVP S DIC="^"_$P(GMRCVP,";",2)_$P(GMRCVP,";")_",0)" I $L(DIC),$D(@DIC) S GMRCNM=@(DIC),GMRCNM=$P(GMRCNM,"^",2)
  1. I '$D(ORSTS) S ORSTS=6 ;Assume order entry status of active
  1. S GMRCA=$O(^GMR(123.1,"AC",+ORSTS,"")) I 'GMRCA S GMRCA=9
  1. S DIE=123,DA=GMRCO,DR="11////^S X=GMRCSR;8////^S X=ORSTS;9////^S X=GMRCA"
  1. L +^GMR(123,GMRCO):$S($G(DILOCKTM)>0:DILOCKTM,1:5) I '$T S GMRCMSG="Consult/Request Is Being Used By Another User.",GMRCMSG(1)="RESULT UPDATE WAS UNSUCCESSFUL! Try Again Later" D EXAC^GMRCADC(.GMRCMSG) K GMRCO,ORIFN,GMRCMSG D KILL Q
  1. D ^DIE K DIE,DA,DR
  1. L -^GMR(123,GMRCO) D AUDIT^GMRCP
  1. S:'$D(ORIFN) ORIFN=$P(^GMR(123,+GMRCO,0),"^",3)
  1. S GMRCORNP=$P(GMR(0),"^",14),GMRCTYPE=$P(GMR(0),"^",17)
  1. I $L($P(GMR(0),"^",14)),$P(GMR(0),"^",14)'=DUZ S GMRCADUZ($P(GMR(0),"^",14))=""
  1. I ORIFN D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM)
  1. K GMR,GMRCSS,GMRCORVP,GMRCVP,GMRCNM,DIC,GMRCPR
  1. Q
  1. ;
  1. PACKAGE() ; Returns the package entry number for 'CONSULT/REQUEST TRACKING"
  1. Q $$FIND1^DIC(9.4,,"QX","CONSULT/REQUEST TRACKING")
  1. ;