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

GMRCGUIA.m

Go to the documentation of this file. 
  1. GMRCGUIA ;SLC/DCM,JFR - File Consult actions from GUI  ;7/8/03 07:36
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,15,22,35**;DEC 27, 1997
  1.  ;
  1.  ; This routine invokes IA #2638,#2926
  1.  ;
  1. NEW(DFN,GMRCDA,GMRCLOC,GMRCTYPE,GMRCSVC,GMRCPROV,GMRCURG,GMRCPLI,GMRCNP,GMRCATN,GMRCINOT,GMRCDIAG,GMRCRFQ) ;Add a new consult for a patient.
  1.  ;DFN=Patient ^DPT( file number
  1.  ;GMRCRFQ=Reason For Request, why the consult is being ordered. Passed in as
  1.  ;    an array
  1.  ;GMRCDIAG=Povisional diagnosis; what is suspected to be the problem
  1.  ;GMRCTYPE=Request type -Consult or Procedure
  1.  ;GMRCLOC=Patient location.
  1.  ;GMRCDA=Date Time of Request
  1.  ;GMRCSVC=To Service; consulting service
  1.  ;GMRCLOC=Hospital Location ordering consult
  1.  ;GMRCPR=If a procedure, the procedure ordered (pointer to file 101)
  1.  ;GMRCURG=Urgency of request (stat, routine, etc) from file 101
  1.  ;GMRCPLI=Place of consultation (bedside, consultants choice, etc.) from file 101
  1.  ;GMRCPROV=Sending Provider
  1.  ;GMRCATN=if consult is to go to a specific provider, this provider is identified here.
  1.  ;GMRCINOT=Service provided as Inpatient or Outpatient
  1.  N DIC,DLAYGO,Y,DIE,GMRCADUZ,X,GMRCO,DR
  1.  S DIC="^GMR(123,",DIC(0)="L",X="""N""",DLAYGO=123 D ^DIC K DLAYGO
  1.  S (DA,GMRCO)=+Y,GMRCSTS=5,GMRCA=1,DIE=DIC
  1.  L +^GMR(123,GMRC0)
  1.  S DR=".02////^S X=DFN;.04////^S X=GMRCLOC;1////^S X=GMRCSVC;3////^S X=GMRCDA;4////^S X=GMRCPR;5////^S X=GMRCURG;6////^S X=GMRCPLI"_$S(GMRCATN]"":"7////^S X=GMRCATN",1:"")
  1.  D ^DIE
  1.  S DR="8////^S X=GMRCSTS;9////^S X=GMRCA;10////^S X=GMRCPROV;11////^S X=GMRCATN;13////^S X=GMRCTYPE;14////^S X=GMRCINOT"_$S($D(GMRCDIAG):"30:////^S X=GMRCDIAG",1:"")
  1.  D ^DIE L -^GMR(123,GMRCO)
  1.  I $O(GMRCRFQ(0)) D REASON^GMRCGUIB(GMRCO,GMRCRFQ,GMRCDA)
  1.  D EN^GMRCHL7(DFN,GMRCDA,GMRCTYPE,$G(GMRCRB),"NW",DUZ,$G(VISIT),"")
  1.  D EXIT
  1.  Q
  1.  ;
  1. RC(GMRCO,GMRCORNP,GMRCAD,GMRCMT,GMRCDUZ) ;Receive consult into service
  1.  ;
  1.  ;Input variables:
  1.  ;GMRCO - The internal file number of the consult from File 123
  1.  ;GMRCORNP - Name of the person who actually 'Received'the consult 
  1.  ;GMRCDUZ - DUZ of person entering the consult as being 'RECEIVED'.
  1.  ;GMRCAD - Actual date time that consult was received into the service.
  1.  ;GMRCMT - array of comments if entered (by reference)
  1.  ;   ARRAY(1)="FIRST LINE OF COMMENT"
  1.  ;   ARRAY(2)="SECOND LINE OF COMMENT"
  1.  ;GMRCDUZ - DUZ of person entering the consult as being 'RECEIVED'
  1.  ;
  1.  ;Output:
  1.  ;GMRCERR - Error Condition Code: 0 = NO error, 1=error
  1.  ;GMRCERMS - Error message or null
  1.  ;  returned as GMRCERR^GMRCERMS
  1.  ;
  1.  N DFN,GMRCSTS,GMRCNOW,GMRCERR,GMRCERMS
  1.  S GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT
  1.  S:$G(GMRCAD)="" GMRCAD=GMRCNOW
  1.  S:'$G(GMRCDUZ) GMRCDUZ=DUZ
  1.  S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  S GMRCSTS=6,GMRCA=21
  1.  D STATUS^GMRCP I $D(GMRCQUT) D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  I '$O(GMRCMT(0)) D AUDIT^GMRCP
  1.  I $O(GMRCMT(0)) D
  1.  . S DA=$$SETDA^GMRCGUIB
  1.  . D SETCOM^GMRCGUIB(.GMRCMT,GMRCDUZ)
  1.  D EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"","")
  1.  D EXIT
  1.  Q GMRCERR_"^"_GMRCERMS
  1.  ;
  1. DC(GMRCO,GMRCORNP,GMRCAD,GMRCACTM,GMRCOM) ;Discontinue or Deny a consult
  1.  ;
  1.  ;Input variables:
  1.  ;GMRCO - Internal file number of consult from File 123
  1.  ;GMRCORNP - Provider who Discontinued or Denied consult
  1.  ;GMRCAD - FM date/time of actual activity.
  1.  ;GMRCACTM - set to "DY" if 'CANCELLED'(old DENY)
  1.  ;           set to "DC" if consult is Discontinued 
  1.  ;GMRCOM - Comment array containing explanation of action
  1.  ;    Passed by reference in the following form :
  1.  ;     ARRAY(1)="xxx xxx xxx"
  1.  ;     ARRAY(2)="XXX XXX"
  1.  ;     ARRAY(3)="XXX XXX xx", etc.
  1.  ;  Comment is a required field when consult is denied or discontinued.
  1.  ;
  1.  ;Output:
  1.  ;GMRCERR=Error Flag: 0 if no error, 1 if error occurred 
  1.  ;GMRCERMS - Error message or null
  1.  ; returned as GMRCERR^GMRCERMS
  1.  ;
  1.  N GMRCDUZ,DFN,GMRCNOW,GMRCSTS,GMRCERR,GMRCERMS,GMRCADUZ,GMRCTRLC
  1.  S GMRCERR=0,GMRCERMS=""
  1.  S GMRCDUZ=DUZ,GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT
  1.  K GMRCQUT
  1.  S:$G(GMRCAD)="" GMRCAD=GMRCNOW
  1.  S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  I '$D(GMRCOM) S GMRCERR=1,GMRCERMS="Comments are required for this action." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  S GMRCSTS=$P(^ORD(100.01,$P(^GMR(123,GMRCO,0),"^",12),0),U,2)
  1.  I GMRCSTS="dc" S GMRCERR=1,GMRCERMS="Order Has Already Been Discontinued." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  I GMRCSTS="ca" S GMRCERR=1,GMRCERMS="Order Has Already Been Cancelled." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  I GMRCSTS="comp" S GMRCERR=1,GMRCERMS="Order Has Already Been Completed." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  S GMRCA=$S(GMRCACTM="DC":6,1:19),GMRCSTS=$S(GMRCA=6:1,1:13)
  1.  D STATUS^GMRCP I $D(GMRCQUT) D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  I GMRCACTM="DC",$$DCPRNT^GMRCUTL1(GMRCO,DUZ) D PRNT^GMRCUTL1("",GMRCO)
  1.  S DA=$$SETDA^GMRCGUIB D SETCOM^GMRCGUIB(.GMRCOM)
  1.  S GMRCOM(0)=DA
  1.  S GMRCTRLC=$S(GMRCACTM="DC":"OD",1:"OC")
  1.  D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),GMRCTRLC,GMRCORNP,$G(GMRCVSIT),.GMRCOM,,GMRCAD)
  1.  S GMRCORTX=$S(GMRCACTM="DY":"Cancelled",1:"Discontinued")_" consult "
  1.  S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
  1.  S GMRCADUZ="",GMRCFL=0
  1.  I GMRCACTM="DC" D
  1.  . S GMRCFL=$$DCNOTE^GMRCADC(GMRCO,DUZ) ;NOTIFY SERVICE ON DC ?
  1.  I +$P($G(^GMR(123,+GMRCO,0)),"^",14),$P(^(0),"^",14)'=DUZ D
  1.  . S GMRCADUZ($P(^(0),"^",14))=""
  1.  ;send notification
  1.  N NOTYPE S NOTYPE=$S(GMRCA=6:23,1:30)
  1.  D MSG^GMRCP(DFN,GMRCORTX,+GMRCO,NOTYPE,.GMRCADUZ,GMRCFL)
  1.  D EXIT
  1.  Q GMRCERR_"^"_GMRCERMS
  1.  ;
  1. FR(GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,GMRCOM,GMRCAD) ;FWD consult
  1.  ;to another service
  1.  ;
  1.  ;Input variables:
  1.  ;GMRCO=File 123 IEN of the consult record
  1.  ;GMRCSS=service being forwarded to; ptr to REQUEST SERVICES (#123.5)
  1.  ;GMRCORNP=Provider Responsible for action
  1.  ;GMRCATTN=NEW PERSON to whose attention action should be directed
  1.  ;GMRCURGI=urgency from PROTOCOL(#101) file
  1.  ;GMRCOM=Comment array containing explanation of action
  1.  ;    Passed by reference in the following form :
  1.  ;     ARRAY(1)="xxx xxx xxx"
  1.  ;     ARRAY(2)="XXX XXX"
  1.  ;     ARRAY(3)="XXX XXX xx", etc.
  1.  ;GMRCAD=FM date/time of actual activity
  1.  ;
  1.  ;Output:
  1.  ;  GMRCERR=Error Flag: 0 if no error, 1 if error occurred 
  1.  ;  GMRCERMS - Error message or null
  1.  ;     returned as GMRCERR^GMRCERMS
  1.  ;
  1.  N DR,GMRCDUZ,GMRCNOW,GMRCFF,GMRCFR,GMRCADUZ,GMRCURG
  1.  N GMRCERR,GMRCERMS,GMRCIROL,GMRCINM,GMRCIROU
  1.  S GMRCERR=0,GMRCERMS=""
  1.  S DFN=$P(^GMR(123,+GMRCO,0),U,2)
  1.  S GMRCDUZ=DUZ,GMRCNOW=$$NOW^XLFDT
  1.  S:'$G(GMRCAD) GMRCAD=GMRCNOW  ;Actual FM date/time consult was FWD'd 
  1.  S:'$G(GMRCURGI) GMRCURGI=$P(^GMR(123,GMRCO,0),U,9)
  1.  S GMRCA=17,GMRCSTS=5
  1.  S GMRCFF=$P($G(^GMR(123.5,+GMRCSS,123)),U,9) ;printed to new serv
  1.  S GMRCFR=$P($G(^GMR(123,+GMRCO,0)),"^",5) ;Get current service 
  1.  S DIE="^GMR(123,",DA=GMRCO,DR=""
  1.  I $D(^GMR(123.5,+GMRCSS,"IFC")) D  ; if fwd to IFC serv, get extra flds
  1.  . S GMRCIROU=$P(^GMR(123.5,+GMRCSS,"IFC"),U) Q:GMRCIROU=""  ;no rout fac
  1.  . S GMRCINM=$P(^GMR(123.5,+GMRCSS,"IFC"),U,2) Q:GMRCINM=""  ;no serv nm
  1.  . S GMRCA=25,GMRCIROL="P"
  1.  . S DR=".07////^S X=GMRCIROU;.125////^S X=GMRCIROL;.131///^S X=GMRCINM;"
  1.  S DR=DR_"1////^S X=$G(GMRCSS);5////^S X=$G(GMRCURGI);8////^S X=$G(GMRCSTS);9////^S X=$G(GMRCA);.1///@"_$S($L($G(GMRCATTN)):";7////^S X=GMRCATTN",1:"")
  1.  L +^GMR(123,GMRCO):3 I '$T K DIE,DA,DR S GMRCERR=1,GMRCERMS="Data Not Filed - File In Use By Another User." D EXIT Q GMRCERR_"^"_GMRCERMS
  1.  D ^DIE L -^GMR(123,GMRCO) K DIE,DA,DR
  1.  S DA=$$SETDA^GMRCGUIB D SETCOM^GMRCGUIB(.GMRCOM)
  1.  S GMRCURG=$P($G(^ORD(101,+GMRCURGI,0)),"^",2)
  1.  D DEM^GMRCU ;sets GMRCRB and other variables
  1.  D TYPE^GMRCAFRD ;sets GMRCTYPE
  1.  D FRMSG^GMRCAFRD ;create XX HL7 message for OE/RR and send alert 
  1.  D EXIT
  1.  Q GMRCERR_"^"_GMRCERMS
  1.  ;
  1. RT(GMRCO,TMPGLOB) ;Set ^TMP("GMRCR",$J,"DT", with results from med and TIU
  1.  ;GMRCO=IEN of consult from file 123
  1.  ;Set TMPGLOB to a ^TMP global other than ^TMP("GMRCR",$J,"MCAR", or ^TMP("GMRCR",$J,"RES", i.e., S TMPGLOB="^TMP(""GMRCR"",$J,""RT"")"'
  1.  Q:'$G(GMRCO)
  1.  K @TMPGLOB
  1.  S GMRCDVL="",$P(GMRCDVL,"-",41)=""
  1.  S GMRCSR=$P(^GMR(123,+GMRCO,0),"^",15),GMRCTUFN=$P(^(0),"^",20)
  1.  S GMRCRTFL=$S('+GMRCSR&('GMRCTUFN):1,1:0)
  1.  ;
  1.  D GETRSLT^GMRCART(TMPGLOB)
  1.  ;
  1.  D EXIT
  1.  Q
  1. EXIT ;kill off variables for exit from actions
  1.  K GMRCA,GMRCDVL,GMRCSR,GMRCRTFL,GMRCFL,GMRCORNP,GMRCQUT,GMRCSTS,GMRCTUFN
  1.  K GMRCRTFL,GMRCADUZ,GMRCORTX
  1.  Q