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

ORQQCN2.m

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