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