ORQQCN2 ; slc/REV - Functions for GUI consult actions ;Sep 09, 2020@13:31:05
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,149,215,242,280,350,519**;Dec 17, 1997;Build 36
;
; DBIA 2426 SERV1^GMRCASV ^TMP("GMRCSLIST,$J)
; DBIA 4576 $$VALID^GMRCAU
;
CMT(ORERR,ORIEN,ORCOM,ORALRT,ORALTO,ORDATE) ;Add comment to existing consult without changing status
;ORIEN - IEN of consult from File 123
;ORERR - return array for results/errors
;ORCOM is the comments array to be added
; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
;ORALRT - should alerts be sent to anyone?
;ORALTO - array of alert recipient IENs
N ORAD,ORDUZ,ORNP,X
S ORERR=0,ORAD=$S($D(ORDATE):ORDATE,1:$$NOW^XLFDT),ORNP=""
I '$D(ORCOM) S ORERR="1^Comments required - no action taken" Q
I '$D(^GMR(123,ORIEN)) S ORERR="1^No such consult" Q
I $G(ORALRT)=1 D
.F I=1:1 S X=$P(ORALTO,";",I) Q:X="" S ORDUZ(X)=""
D CMT^GMRCGUIB(ORIEN,.ORCOM,.ORDUZ,ORAD,DUZ)
Q
;
SCH(ORERR,ORIEN,ORNP,ORDATE,ORALRT,ORALTO,ORCOM) ;Schedule consult and change status
;ORERR - return array for results/errors
;ORIEN - IEN of consult from File 123
;ORNP - Provider who Scheduled consult
;ORDATE - Date/Time Consult was scheduled.
;ORALRT - should alerts be sent to anyone?
;ORALTO - array of alert recipient IENs
;ORCOM is the comments array to be added
; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
N ORAD,ORDUZ,X
S ORERR=0,ORAD=$S($D(ORDATE):ORDATE,1:$$NOW^XLFDT)
S:+$G(ORNP)=0 ORNP=DUZ
I '$D(^GMR(123,ORIEN)) S ORERR="1^No such consult" Q
I $G(ORALRT)=1 D
.F I=1:1 S X=$P(ORALTO,";",I) Q:X="" S ORDUZ(X)=""
S ORERR=$$SCH^GMRCGUIB(ORIEN,ORNP,ORAD,.ORDUZ,.ORCOM)
Q
;
SVCTREE(Y,PURPOSE) ;Returns list of consult service for current
; context, screening for inactive, groupers, and tracking
; PURPOSE: Display=0, Forward=1, Order=1
N GMRCTO,GMRCDG,GMRCSVC,GMRCOI
S GMRCTO=PURPOSE,GMRCDG=1
D SERV1^GMRCASV
S GMRCSVC=0
I '$D(^TMP("GMRCSLIST",$J)) S Y(1)="-1^No services found" Q ;DBIA 2426
F I=1:1 S GMRCSVC=$O(^TMP("GMRCSLIST",$J,GMRCSVC)) Q:+GMRCSVC=0 D
. S Y(I)=^TMP("GMRCSLIST",$J,GMRCSVC)
. S GMRCOI=$O(^ORD(101.43,"ID",$P(Y(I),U,1)_";99CON",0))
. S Y(I)=Y(I)_U_GMRCOI
Q
;
SVCSYN(ORROOT,ORSTRT,ORWHY,ORSYN,ORIEN) ;;return CSLT services for GUI
;Input:
; ORROOT - passed in as the array to return results in
; ORSTRT- service to begin building from
; ORWHY - 0 for display, 1 for forwarding or ordering
; ORSYN - Boolean: 1=return synonyms, 0=do not
; ORIEN - Consult IEN (file 123) (OPTIONAL)
;Output: Array formatted as follows-
; svc ien^svc name or syn^parent^has children^svc usage^orderable item
N ORSVC,I,X,OI
S:+$G(ORSTRT)=0 ORSTRT=1
S:$G(ORWHY)="" ORWHY=1
S:$G(ORSYN)="" ORSYN=1
S ORROOT=$NA(^TMP("ORCSLT",$J))
D GUI^GMRCASV1(ORROOT,ORSTRT,ORWHY,ORSYN,$G(ORIEN))
S ORSVC=0
I '$D(@ORROOT) S @ORROOT@(1)="-1^No services found" Q
F I=1:1 S ORSVC=$O(@ORROOT@(ORSVC)) Q:+ORSVC=0 D
. S X=@ORROOT@(ORSVC)
. S OI=$O(^ORD(101.43,"ID",$P(X,U,1)_";99CON",0))
. I +OI>0 S @ORROOT@(ORSVC)=X_U_OI
Q
STATUS(Y) ; Returns a list of statuses currently in use
;
N GMRCORST
S GMRCORST=0,Y(999)="999^OTHER^"
F S GMRCORST=$O(^ORD(100.01,GMRCORST)) Q:'+GMRCORST D
. I '$D(^GMR(123.1,"AC",GMRCORST)) S Y(999)=Y(999)_GMRCORST_"," Q
. Q:$$SCREEN^XTID(100.01,,GMRCORST_",") ;inactive VUID
. S Y(GMRCORST)=GMRCORST_U_$P(^ORD(100.01,GMRCORST,0),U,1)
Q
;
MEDRSLT(ORY,GMRCO) ;Returns Medicine results plus TIU results
S ORY=$NA(^TMP("ORRSLT",$J))
D RT^GMRCGUIA(GMRCO,ORY)
Q
;
SHOW513(ORY,GMRCO) ;CONSULTS SF513 DISPLAY IN GUI
D GUI^GMRCP5(.ORY,GMRCO)
Q
PRT513(Y,GMRCO,GMRCCHT,GMRCDEV) ; Print SF513 to VistA device from GUI
N ORSTATUS
D EN^GMRCP5(GMRCO,GMRCCHT,GMRCDEV,.ORSTATUS)
S Y=ORSTATUS
Q
WPRT513(ORY,GMRCO,GMRCCHT) ;Print SF513 to Windows device from GUI
N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORHANDLE
N IOM,IOSL,IOST,IOF,IOT,IOS
S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORHANDLE="ORQQCN2"
S ORY=$NA(^TMP(ORSUB,$J,1))
S ORHFS=$$HFS^ORWRP()
D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
I POP D Q
. I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for SF513 print")
D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
N $ETRAP,$ESTACK
S $ETRAP="D ERR^ORWRP Q"
U IO
D PRNT^GMRCP5A(GMRCO,0,0,GMRCCHT,0)
D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
Q
SIGFIND(Y,ORIEN,ORFL,ORCOM,ORALRT,ORALTO,ORDATE) ;Significant findings
S Y=$$SFILE^GMRCGUIB(ORIEN,4,ORFL,"",DUZ,.ORCOM,ORALRT,ORALTO,ORDATE) ; "4"=SIG FIND ACTION
Q
ADMCOMPL(Y,ORIEN,ORFL,ORCOM,ORRESP,ORALRT,ORALTO,ORDATE) ; Admin users
; Administrative complete action
S Y=$$SFILE^GMRCGUIB(ORIEN,10,ORFL,ORRESP,DUZ,.ORCOM,ORALRT,ORALTO,ORDATE) ; "10"=Admin Complete
Q
SVCLIST(ORY,FROM,DIR) ; Return a set of consult services in long list format
; .ORY=returned list, FROM=text to $O from, DIR=$O direction,
N I,IEN,CNT,Y,ORTMP,ORSVC,ORSTR
S I=0,CNT=44,ORSVC=""
D SVCTREE^ORQQCN2(.Y,1)
F I=1:1 S ORSVC=$P($G(Y(I)),U,2) Q:ORSVC="" D
. S ORTMP(ORSVC)=Y(I)
F I=1:1 Q:I=CNT S FROM=$O(ORTMP(FROM),DIR) Q:FROM="" D
. S ORSTR=ORTMP(FROM)
. S ORY(I)=ORSTR
Q
GETCTXT(Y,ORUSER) ; Returns current view context for user
S Y=$$GET^XPAR("ALL","ORCH CONTEXT CONSULTS",1)
Q
SAVECTXT(Y,ORCTXT) ; Save new view preferences for user
N TMP
S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1)
I TMP'="" D Q
. D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
Q
;
DEFRFREQ(ORY,ORSVC,ORDFN,RESOLVE) ;Return default reason for request for service
; ORSVC=pointer to file 123.5
; ORDFN=patient, if RESOLVE=1
; RESOLVE=1 to resolve boilerplate, 0 to not resolve
Q:+$G(ORSVC)=0
I +RESOLVE,(+$G(ORDFN)=0) Q
S ORY=$NA(^TMP("ORREQ",$J))
S:$G(RESOLVE)="" RESOLVE=0
D GETDEF^GMRCDRFR(.ORY,ORSVC,ORDFN,RESOLVE)
K @ORY@(0)
Q
EDITDRFR(ORY,ORSVC) ; Allow editing of reason for request?
S ORY=$$REAF^GMRCDRFR(ORSVC)
Q
SVCIEN(ORY,ORIEN) ;Given orderable item file entry, return IEN in 123.5, OR -1 IF INACTIVE IN 101.43
N X1
I '$D(^ORD(101.43,ORIEN)) S ORY=-1 Q
S X1=$G(^ORD(101.43,ORIEN,.1))
I +X1,+X1<$$NOW^XLFDT S ORY=-1 Q
S ORY=$P($$USID^ORWDXC(ORIEN),U,4)
Q
PROVDX(ORY,ORIEN) ;Return provisional dx prompting info for service
S ORY=$$PROVDX^GMRCUTL1(ORIEN)
Q
PREREQ(ORY,ORSVC,ORDFN) ;Returns prequisites for ordering
Q:(+$G(ORSVC)=0)!(+$G(ORDFN)=0)
S ORY=$NA(^TMP("ORPREREQ",$J))
D PREREQ^GMRCUTL1(.ORY,ORSVC,ORDFN,0) ;0=RESOLVE OBJECTS
K @ORY@(0)
Q
UNRSLVD(ORY,ORDFN) ;Returns true if unresolved consults for user/pt
;S ORY=0
;Q:+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")=0
;S ORY=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
;Q
S $P(ORY,U,1)=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
S $P(ORY,U,2)=+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")
Q
ISPROSVC(ORY,ORIEN) ; IS THIS SERVICE PART OF CONSULTS-PROSTHETICS INTERFACE, wat/OR*3*280
;ORIEN - IEN of selected service
S ORY=0
I $G(^GMR(123.5,$G(ORIEN),"INT"))=1 S ORY=1
Q
VALID(ORY,GMRCIEN,ORDUZ,ORIFC) ;Return users update authority for a consult
;ORIFC - If received, will include check for IFC Coordinator
I +$G(GMRCIEN)=0 S ORY="-1^Consult Service Required" Q
I +$G(ORDUZ)=0 S ORDUZ=DUZ
I $G(ORIFC)="" S ORIFC=0
S ORY=$$VALID^GMRCAU(GMRCIEN,,ORDUZ,,ORIFC) ;DBIA #4576
I ORY="" S ORY=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQCN2 7564 printed Oct 16, 2024@18:34:09 Page 2
ORQQCN2 ; slc/REV - Functions for GUI consult actions ;Sep 09, 2020@13:31:05
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,149,215,242,280,350,519**;Dec 17, 1997;Build 36
+2 ;
+3 ; DBIA 2426 SERV1^GMRCASV ^TMP("GMRCSLIST,$J)
+4 ; DBIA 4576 $$VALID^GMRCAU
+5 ;
CMT(ORERR,ORIEN,ORCOM,ORALRT,ORALTO,ORDATE) ;Add comment to existing consult without changing status
+1 ;ORIEN - IEN of consult from File 123
+2 ;ORERR - return array for results/errors
+3 ;ORCOM is the comments array to be added
+4 ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
+5 ;ORALRT - should alerts be sent to anyone?
+6 ;ORALTO - array of alert recipient IENs
+7 NEW ORAD,ORDUZ,ORNP,X
+8 SET ORERR=0
SET ORAD=$SELECT($DATA(ORDATE):ORDATE,1:$$NOW^XLFDT)
SET ORNP=""
+9 IF '$DATA(ORCOM)
SET ORERR="1^Comments required - no action taken"
QUIT
+10 IF '$DATA(^GMR(123,ORIEN))
SET ORERR="1^No such consult"
QUIT
+11 IF $GET(ORALRT)=1
Begin DoDot:1
+12 FOR I=1:1
SET X=$PIECE(ORALTO,";",I)
if X=""
QUIT
SET ORDUZ(X)=""
End DoDot:1
+13 DO CMT^GMRCGUIB(ORIEN,.ORCOM,.ORDUZ,ORAD,DUZ)
+14 QUIT
+15 ;
SCH(ORERR,ORIEN,ORNP,ORDATE,ORALRT,ORALTO,ORCOM) ;Schedule consult and change status
+1 ;ORERR - return array for results/errors
+2 ;ORIEN - IEN of consult from File 123
+3 ;ORNP - Provider who Scheduled consult
+4 ;ORDATE - Date/Time Consult was scheduled.
+5 ;ORALRT - should alerts be sent to anyone?
+6 ;ORALTO - array of alert recipient IENs
+7 ;ORCOM is the comments array to be added
+8 ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
+9 NEW ORAD,ORDUZ,X
+10 SET ORERR=0
SET ORAD=$SELECT($DATA(ORDATE):ORDATE,1:$$NOW^XLFDT)
+11 if +$GET(ORNP)=0
SET ORNP=DUZ
+12 IF '$DATA(^GMR(123,ORIEN))
SET ORERR="1^No such consult"
QUIT
+13 IF $GET(ORALRT)=1
Begin DoDot:1
+14 FOR I=1:1
SET X=$PIECE(ORALTO,";",I)
if X=""
QUIT
SET ORDUZ(X)=""
End DoDot:1
+15 SET ORERR=$$SCH^GMRCGUIB(ORIEN,ORNP,ORAD,.ORDUZ,.ORCOM)
+16 QUIT
+17 ;
SVCTREE(Y,PURPOSE) ;Returns list of consult service for current
+1 ; context, screening for inactive, groupers, and tracking
+2 ; PURPOSE: Display=0, Forward=1, Order=1
+3 NEW GMRCTO,GMRCDG,GMRCSVC,GMRCOI
+4 SET GMRCTO=PURPOSE
SET GMRCDG=1
+5 DO SERV1^GMRCASV
+6 SET GMRCSVC=0
+7 ;DBIA 2426
IF '$DATA(^TMP("GMRCSLIST",$JOB))
SET Y(1)="-1^No services found"
QUIT
+8 FOR I=1:1
SET GMRCSVC=$ORDER(^TMP("GMRCSLIST",$JOB,GMRCSVC))
if +GMRCSVC=0
QUIT
Begin DoDot:1
+9 SET Y(I)=^TMP("GMRCSLIST",$JOB,GMRCSVC)
+10 SET GMRCOI=$ORDER(^ORD(101.43,"ID",$PIECE(Y(I),U,1)_";99CON",0))
+11 SET Y(I)=Y(I)_U_GMRCOI
End DoDot:1
+12 QUIT
+13 ;
SVCSYN(ORROOT,ORSTRT,ORWHY,ORSYN,ORIEN) ;;return CSLT services for GUI
+1 ;Input:
+2 ; ORROOT - passed in as the array to return results in
+3 ; ORSTRT- service to begin building from
+4 ; ORWHY - 0 for display, 1 for forwarding or ordering
+5 ; ORSYN - Boolean: 1=return synonyms, 0=do not
+6 ; ORIEN - Consult IEN (file 123) (OPTIONAL)
+7 ;Output: Array formatted as follows-
+8 ; svc ien^svc name or syn^parent^has children^svc usage^orderable item
+9 NEW ORSVC,I,X,OI
+10 if +$GET(ORSTRT)=0
SET ORSTRT=1
+11 if $GET(ORWHY)=""
SET ORWHY=1
+12 if $GET(ORSYN)=""
SET ORSYN=1
+13 SET ORROOT=$NAME(^TMP("ORCSLT",$JOB))
+14 DO GUI^GMRCASV1(ORROOT,ORSTRT,ORWHY,ORSYN,$GET(ORIEN))
+15 SET ORSVC=0
+16 IF '$DATA(@ORROOT)
SET @ORROOT@(1)="-1^No services found"
QUIT
+17 FOR I=1:1
SET ORSVC=$ORDER(@ORROOT@(ORSVC))
if +ORSVC=0
QUIT
Begin DoDot:1
+18 SET X=@ORROOT@(ORSVC)
+19 SET OI=$ORDER(^ORD(101.43,"ID",$PIECE(X,U,1)_";99CON",0))
+20 IF +OI>0
SET @ORROOT@(ORSVC)=X_U_OI
End DoDot:1
+21 QUIT
STATUS(Y) ; Returns a list of statuses currently in use
+1 ;
+2 NEW GMRCORST
+3 SET GMRCORST=0
SET Y(999)="999^OTHER^"
+4 FOR
SET GMRCORST=$ORDER(^ORD(100.01,GMRCORST))
if '+GMRCORST
QUIT
Begin DoDot:1
+5 IF '$DATA(^GMR(123.1,"AC",GMRCORST))
SET Y(999)=Y(999)_GMRCORST_","
QUIT
+6 ;inactive VUID
if $$SCREEN^XTID(100.01,,GMRCORST_",")
QUIT
+7 SET Y(GMRCORST)=GMRCORST_U_$PIECE(^ORD(100.01,GMRCORST,0),U,1)
End DoDot:1
+8 QUIT
+9 ;
MEDRSLT(ORY,GMRCO) ;Returns Medicine results plus TIU results
+1 SET ORY=$NAME(^TMP("ORRSLT",$JOB))
+2 DO RT^GMRCGUIA(GMRCO,ORY)
+3 QUIT
+4 ;
SHOW513(ORY,GMRCO) ;CONSULTS SF513 DISPLAY IN GUI
+1 DO GUI^GMRCP5(.ORY,GMRCO)
+2 QUIT
PRT513(Y,GMRCO,GMRCCHT,GMRCDEV) ; Print SF513 to VistA device from GUI
+1 NEW ORSTATUS
+2 DO EN^GMRCP5(GMRCO,GMRCCHT,GMRCDEV,.ORSTATUS)
+3 SET Y=ORSTATUS
+4 QUIT
WPRT513(ORY,GMRCO,GMRCCHT) ;Print SF513 to Windows device from GUI
+1 NEW ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORHANDLE
+2 NEW IOM,IOSL,IOST,IOF,IOT,IOS
+3 SET (ORSUB,ROOT)="ORDATA"
SET ORIO="OR WINDOWS HFS"
SET ORHANDLE="ORQQCN2"
+4 SET ORY=$NAME(^TMP(ORSUB,$JOB,1))
+5 SET ORHFS=$$HFS^ORWRP()
+6 DO HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
+7 IF POP
Begin DoDot:1
+8 IF $DATA(ROOT)
DO SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for SF513 print")
End DoDot:1
QUIT
+9 DO IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
+10 NEW $ETRAP,$ESTACK
+11 SET $ETRAP="D ERR^ORWRP Q"
+12 USE IO
+13 DO PRNT^GMRCP5A(GMRCO,0,0,GMRCCHT,0)
+14 DO HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
+15 QUIT
SIGFIND(Y,ORIEN,ORFL,ORCOM,ORALRT,ORALTO,ORDATE) ;Significant findings
+1 ; "4"=SIG FIND ACTION
SET Y=$$SFILE^GMRCGUIB(ORIEN,4,ORFL,"",DUZ,.ORCOM,ORALRT,ORALTO,ORDATE)
+2 QUIT
ADMCOMPL(Y,ORIEN,ORFL,ORCOM,ORRESP,ORALRT,ORALTO,ORDATE) ; Admin users
+1 ; Administrative complete action
+2 ; "10"=Admin Complete
SET Y=$$SFILE^GMRCGUIB(ORIEN,10,ORFL,ORRESP,DUZ,.ORCOM,ORALRT,ORALTO,ORDATE)
+3 QUIT
SVCLIST(ORY,FROM,DIR) ; Return a set of consult services in long list format
+1 ; .ORY=returned list, FROM=text to $O from, DIR=$O direction,
+2 NEW I,IEN,CNT,Y,ORTMP,ORSVC,ORSTR
+3 SET I=0
SET CNT=44
SET ORSVC=""
+4 DO SVCTREE^ORQQCN2(.Y,1)
+5 FOR I=1:1
SET ORSVC=$PIECE($GET(Y(I)),U,2)
if ORSVC=""
QUIT
Begin DoDot:1
+6 SET ORTMP(ORSVC)=Y(I)
End DoDot:1
+7 FOR I=1:1
if I=CNT
QUIT
SET FROM=$ORDER(ORTMP(FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+8 SET ORSTR=ORTMP(FROM)
+9 SET ORY(I)=ORSTR
End DoDot:1
+10 QUIT
GETCTXT(Y,ORUSER) ; Returns current view context for user
+1 SET Y=$$GET^XPAR("ALL","ORCH CONTEXT CONSULTS",1)
+2 QUIT
SAVECTXT(Y,ORCTXT) ; Save new view preferences for user
+1 NEW TMP
+2 SET TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1)
+3 IF TMP'=""
Begin DoDot:1
+4 DO CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
End DoDot:1
QUIT
+5 DO ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
+6 QUIT
+7 ;
DEFRFREQ(ORY,ORSVC,ORDFN,RESOLVE) ;Return default reason for request for service
+1 ; ORSVC=pointer to file 123.5
+2 ; ORDFN=patient, if RESOLVE=1
+3 ; RESOLVE=1 to resolve boilerplate, 0 to not resolve
+4 if +$GET(ORSVC)=0
QUIT
+5 IF +RESOLVE
IF (+$GET(ORDFN)=0)
QUIT
+6 SET ORY=$NAME(^TMP("ORREQ",$JOB))
+7 if $GET(RESOLVE)=""
SET RESOLVE=0
+8 DO GETDEF^GMRCDRFR(.ORY,ORSVC,ORDFN,RESOLVE)
+9 KILL @ORY@(0)
+10 QUIT
EDITDRFR(ORY,ORSVC) ; Allow editing of reason for request?
+1 SET ORY=$$REAF^GMRCDRFR(ORSVC)
+2 QUIT
SVCIEN(ORY,ORIEN) ;Given orderable item file entry, return IEN in 123.5, OR -1 IF INACTIVE IN 101.43
+1 NEW X1
+2 IF '$DATA(^ORD(101.43,ORIEN))
SET ORY=-1
QUIT
+3 SET X1=$GET(^ORD(101.43,ORIEN,.1))
+4 IF +X1
IF +X1<$$NOW^XLFDT
SET ORY=-1
QUIT
+5 SET ORY=$PIECE($$USID^ORWDXC(ORIEN),U,4)
+6 QUIT
PROVDX(ORY,ORIEN) ;Return provisional dx prompting info for service
+1 SET ORY=$$PROVDX^GMRCUTL1(ORIEN)
+2 QUIT
PREREQ(ORY,ORSVC,ORDFN) ;Returns prequisites for ordering
+1 if (+$GET(ORSVC)=0)!(+$GET(ORDFN)=0)
QUIT
+2 SET ORY=$NAME(^TMP("ORPREREQ",$JOB))
+3 ;0=RESOLVE OBJECTS
DO PREREQ^GMRCUTL1(.ORY,ORSVC,ORDFN,0)
+4 KILL @ORY@(0)
+5 QUIT
UNRSLVD(ORY,ORDFN) ;Returns true if unresolved consults for user/pt
+1 ;S ORY=0
+2 ;Q:+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")=0
+3 ;S ORY=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
+4 ;Q
+5 ;DBIA #3473
SET $PIECE(ORY,U,1)=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ)
+6 SET $PIECE(ORY,U,2)=+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")
+7 QUIT
ISPROSVC(ORY,ORIEN) ; IS THIS SERVICE PART OF CONSULTS-PROSTHETICS INTERFACE, wat/OR*3*280
+1 ;ORIEN - IEN of selected service
+2 SET ORY=0
+3 IF $GET(^GMR(123.5,$GET(ORIEN),"INT"))=1
SET ORY=1
+4 QUIT
VALID(ORY,GMRCIEN,ORDUZ,ORIFC) ;Return users update authority for a consult
+1 ;ORIFC - If received, will include check for IFC Coordinator
+2 IF +$GET(GMRCIEN)=0
SET ORY="-1^Consult Service Required"
QUIT
+3 IF +$GET(ORDUZ)=0
SET ORDUZ=DUZ
+4 IF $GET(ORIFC)=""
SET ORIFC=0
+5 ;DBIA #4576
SET ORY=$$VALID^GMRCAU(GMRCIEN,,ORDUZ,,ORIFC)
+6 IF ORY=""
SET ORY=0
+7 QUIT
