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

ORQQCN1.m

Go to the documentation of this file. 
  1. ORQQCN1 ; slc/REV - Functions for GUI consult actions - RPCs for GMRCGUIA ; 8-NOV-2000 14:49:16 [1/9/01 10:39am]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,98,85,109,148**;Dec 17, 1997
  1.  ;
  1. RC(Y,GMRCO,GMRCORNP,GMRCAD,ORCOM) ;Receive the consult into the service
  1.  ;GMRCO - The internal file number of the consult from File 123
  1.  ;GMRCORNP - internal file number of the person receiving the request into the service
  1.  ;GMRCAD - date/time consult received into the service
  1.  ;ORCOM - Array containing comments related to receipt of the consult.
  1.  ;Passed as the following form :
  1.  ; ARRAY(1)="xxx xxx xxx",ARRAY(2)="XXX XXX",ARRAY(3)="XXX XXX xx", etc.
  1.  ; Comment is optional when consult is received.
  1.  S Y=$$RC^GMRCGUIA(GMRCO,GMRCORNP,GMRCAD,.ORCOM)
  1.  Q
  1.  ;
  1. DC(Y,GMRCO,GMRCORNP,GMRCAD,GMRCACTM,ORCOM) ;Discontinue or Deny a consult
  1.  ;GMRCO - Internal file number of consult from File 123
  1.  ;GMRCORNP - Provider who Discontinued or Denied consult
  1.  ;GMRCAD - Date/Time Consult was discontinued or denied.
  1.  ;GMRCACTM - If consult is 'DENIED' passed in as 'DY'; if consult is Discontinued passed in as 'DC'.
  1.  ;ORCOM - Array containing explanation of why consult was denied. Passed as the following form :
  1.  ; ARRAY(1)="xxx xxx xxx",ARRAY(2)="XXX XXX",ARRAY(3)="XXX XXX xx", etc.
  1.  ; Comment is a required field when consult is denied or discontinued.
  1.  S Y=$$DC^GMRCGUIA(GMRCO,GMRCORNP,GMRCAD,GMRCACTM,.ORCOM)
  1.  Q
  1.  ;
  1. FR(Y,GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,ORDATE,ORCOM) ;Forward consult/request to another service
  1.  ;GMRCO - IEN of consult from File 123
  1.  ;GMRCSS - Service to which consult is being forwarded
  1.  ;GMRCATTN - Provider whose attention consult is sent to. Can be "" or pointer to File 200
  1.  ;GMRCURGI - Urgency of the request
  1.  ;GMRCORNP - Person who is responsible for forwarding the consult
  1.  ;ORCOM is the comments array explaining the forwarding action
  1.  ;     passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
  1.  S:+$G(GMRCATTN)=0 GMRCATTN=""
  1.  S Y=$$FR^GMRCGUIA(GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,.ORCOM,ORDATE)
  1.  Q
  1.  ;
  1. SETACTM(Y,GMRCO) ;set action menus in GUI based on service of selected consult
  1.  Q:+$G(GMRCO)=0
  1.  N ORFLG
  1.  S Y=0
  1.  D CPRS^GMRCACTM(GMRCO,1)
  1.  Q:'$D(ORFLG(GMRCO))
  1.  S Y=ORFLG(GMRCO)
  1.  Q
  1.  ;
  1. URG(Y,GMRCO) ;new urgency from 101.42
  1.  Q:+$G(GMRCO)=0
  1.  N GMRCURG,X,GMRCCSLT,GMRCPROC,GMRCTYPE,GMRCPROT
  1.  S GMRCCSLT=$O(^ORD(101,"B","GMRCOR CONSULT",0))
  1.  S GMRCPROC=$O(^ORD(101,"B","GMRCOR REQUEST",0))
  1.  S GMRCTYPE=$P(^GMR(123,+GMRCO,0),"^",17)
  1.  I $P(^GMR(123,+GMRCO,0),"^",18)["I" D
  1.  . S X=$S(GMRCTYPE=GMRCCSLT:"S.GMRCT",1:"S.GMRCR")
  1.  E  S X="S.GMRCO"
  1.  S GMRCURG=""
  1.  F I=1:1  S GMRCURG=$O(^ORD(101.42,X,GMRCURG)) Q:GMRCURG=""  D
  1.  .S GMRCPROT=$O(^ORD(101,"B","GMRCURGENCY - "_GMRCURG,0))
  1.  .S Y(I)=GMRCPROT_U_GMRCURG
  1.  .;S Y(I)=$O(^ORD(101.42,X,GMRCURG,0))_U_GMRCURG
  1.  Q
  1.  ;
  1. GETCSLT(ORY,ORIEN,SHOWADD)      ; Retrieve a complete consult record
  1.  N ORDOC,ORREQ,I,X,SEQUENCE,ORI,ORGMRC,MEDRSLTS,ROOT
  1.  S MEDRSLTS=1
  1.  Q:+$G(ORIEN)=0
  1.  I '$D(^GMR(123,ORIEN)) S ORY(0)="-1^Invalid consult" Q
  1.  I $$PATCH^XPDUTL("GMRC*3.0*17") D
  1.  . D DOCLIST^GMRCGUIB(.ORGMRC,ORIEN,MEDRSLTS)
  1.  E  D DOCLIST^GMRCGUIB(.ORGMRC,ORIEN)
  1.  S ORY(0)=ORGMRC(0),ORREQ=$P(ORY(0),U,14)
  1.  S:+$G(SHOWADD) SEQUENCE="D"
  1.  I ORREQ'="",$D(^VA(200,ORREQ,0)) S $P(ORY(0),U,14)=ORREQ_";"_$P(^VA(200,ORREQ,0),U,1)
  1.  S X=0,I=1,ORI=1
  1.  F  S X=$O(ORGMRC(50,X)) Q:X=""  D
  1.  . S ORDOC=$P(ORGMRC(50,X),U,1)
  1.  . S ROOT=U_$P($P(ORDOC,";",2),",",1)_")"
  1.  . Q:'$D(@ROOT@(+ORDOC))
  1.  . I ROOT="^TIU(8925)" D
  1.  . . S ORY(I)=+ORDOC_U_$$RESOLVE^TIUSRVLO(+ORDOC)
  1.  . . S $P(ORY(I),U,14)="1",I=I+1  ; parent treenode=1 for TIU docs
  1.  . . S ORY("INDX",+ORDOC,ORI)=""
  1.  . . I +$G(SHOWADD) D 
  1.  . . . I +$$HASDAD^TIUSRVLI(+ORDOC) S ORI=I+1 D SETDAD^TIUSRVLI("ORY",+ORDOC,.ORI) S I=ORI+1 ; for treeview of related notes
  1.  . . . I +$$HASKIDS^TIUSRVLI(+ORDOC) S ORI=I+1 D SETKIDS^TIUSRVLI("ORY",+ORDOC,.ORI) S I=ORI+1 ; for treeview of related notes
  1.  . E  I $E(ROOT,1,5)="^MCAR" D
  1.  . . S ORY(I)=ORGMRC(50,X)
  1.  . . S $P(ORY(I),U,14)="2",I=I+1     ; parent treenode=2 for med results
  1.  K ORY("INDX")
  1.  Q
  1.  ;
  1. FINDCSLT(Y,GMRCIEN) ; Return list item for the selected consult only
  1.  N ORPT,X0,GMRCOER,SEQ,SEQ0
  1.  Q:+$G(GMRCIEN)=0
  1.  S X0=$G(^GMR(123,GMRCIEN,0)) I 'X0 S Y="-1^Consult not found" Q
  1.  S ORPT=$P(X0,U,2) I '$G(ORPT) S Y="-1^Patient not found" Q
  1.  S GMRCOER=2,SEQ=""
  1.  D OER^GMRCSLM1(ORPT,"","","","",GMRCOER)
  1.  F  S SEQ=$O(^TMP("GMRCR",$J,"CS",SEQ)) Q:SEQ=""!(SEQ?1A.E)  I SEQ>0 D
  1.  .S SEQ0=^TMP("GMRCR",$J,"CS",SEQ,0) I $P(SEQ0,U,1)=GMRCIEN S Y=SEQ0 Q
  1.  K ^TMP("GMRCR",$J)
  1.  Q
  1. PROCIEN(ORY,ORDITM) ; Return pointer to file 123.3 given orderable item
  1.  S ORY=+$P($G(^ORD(101.43,ORDITM,0)),U,2)
  1.  Q
  1. PROCSVCS(ORY,ORDITM) ; Return a list of services for a procedure
  1.  N PROCIEN
  1.  S PROCIEN=$P($G(^ORD(101.43,ORDITM,0)),U,2)
  1.  D GETSVC^GMRCPR0(.ORY,PROCIEN)
  1.  Q
  1.  ;
  1. GETORDER(Y,GMRCO) ; Return OERR order number for consult/procedure
  1.  I +$G(GMRCO)=0 S Y="-1" Q
  1.  S Y=$$ORIFN^GMRCUTL1(GMRCO)
  1.  ;S Y=$P($G(^GMR(123,GMRCO,0)),U,3)
  1.  Q
  1. CANEDIT(Y,GMRCO) ; Return whether consult can be edited and resubmitted
  1.  S Y=$$EDRESOK^GMRCEDT2(GMRCO)
  1.  Q
  1. RESUBMIT(Y,GMRCO,OREDITED) ; Edit/Resubmit a cancelled consult/procedure request
  1.  N ORNODE
  1.  S ORNODE=$NAME(^TMP("GMRCR",$J))
  1.  M @ORNODE=OREDITED
  1.  D FILE^GMRCGUIC(GMRCO,ORNODE)
  1.  S Y=0
  1.  Q
  1. EDITLOAD(Y,GMRCO) ; Load a cancelled consult/procedure for editing
  1.  Q:+$G(GMRCO)=0
  1.  N ORNODE,I
  1.  S ORNODE=$NAME(^TMP("GMRCR",$J)),I=0
  1.  D SEND^GMRCGUIC(GMRCO,ORNODE)
  1.  S Y=ORNODE
  1.  Q