- 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 Feb 19, 2025@00:00:07 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