| 1 | ORQQCN2 ; slc/REV - Functions for GUI consult actions ; 02 April 2003 4:05 PM
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,149,215,242**;Dec 17, 1997;Build 6
|
---|
| 3 | ;
|
---|
| 4 | ; DBIA 2426 SERV1^GMRCASV ^TMP("GMRCSLIST,$J)
|
---|
| 5 | ;
|
---|
| 6 | CMT(ORERR,ORIEN,ORCOM,ORALRT,ORALTO,ORDATE) ;Add comment to existing consult without changing status
|
---|
| 7 | ;ORIEN - IEN of consult from File 123
|
---|
| 8 | ;ORERR - return array for results/errors
|
---|
| 9 | ;ORCOM is the comments array to be added
|
---|
| 10 | ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
|
---|
| 11 | ;ORALRT - should alerts be sent to anyone?
|
---|
| 12 | ;ORALTO - array of alert recipient IENs
|
---|
| 13 | N ORAD,ORDUZ,ORNP,X
|
---|
| 14 | S ORERR=0,ORAD=$S($D(ORDATE):ORDATE,1:$$NOW^XLFDT),ORNP=""
|
---|
| 15 | I '$D(ORCOM) S ORERR="1^Comments required - no action taken" Q
|
---|
| 16 | I '$D(^GMR(123,ORIEN)) S ORERR="1^No such consult" Q
|
---|
| 17 | I $G(ORALRT)=1 D
|
---|
| 18 | .F I=1:1 S X=$P(ORALTO,";",I) Q:X="" S ORDUZ(X)=""
|
---|
| 19 | D CMT^GMRCGUIB(ORIEN,.ORCOM,.ORDUZ,ORAD,DUZ)
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | SCH(ORERR,ORIEN,ORNP,ORDATE,ORALRT,ORALTO,ORCOM) ;Schedule consult and change status
|
---|
| 23 | ;ORERR - return array for results/errors
|
---|
| 24 | ;ORIEN - IEN of consult from File 123
|
---|
| 25 | ;ORNP - Provider who Scheduled consult
|
---|
| 26 | ;ORDATE - Date/Time Consult was scheduled.
|
---|
| 27 | ;ORALRT - should alerts be sent to anyone?
|
---|
| 28 | ;ORALTO - array of alert recipient IENs
|
---|
| 29 | ;ORCOM is the comments array to be added
|
---|
| 30 | ; passed in as ORCOM(1)="Xxxx Xxxxx...",ORCOM(2)="Xxxx Xx Xxx...", ORCOM(3)="Xxxxx Xxx Xx...", etc.
|
---|
| 31 | N ORAD,ORDUZ,X
|
---|
| 32 | S ORERR=0,ORAD=$S($D(ORDATE):ORDATE,1:$$NOW^XLFDT)
|
---|
| 33 | S:+$G(ORNP)=0 ORNP=DUZ
|
---|
| 34 | I '$D(^GMR(123,ORIEN)) S ORERR="1^No such consult" Q
|
---|
| 35 | I $G(ORALRT)=1 D
|
---|
| 36 | .F I=1:1 S X=$P(ORALTO,";",I) Q:X="" S ORDUZ(X)=""
|
---|
| 37 | S ORERR=$$SCH^GMRCGUIB(ORIEN,ORNP,ORAD,.ORDUZ,.ORCOM)
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | SVCTREE(Y,PURPOSE) ;Returns list of consult service for current
|
---|
| 41 | ; context, screening for inactive, groupers, and tracking
|
---|
| 42 | ; PURPOSE: Display=0, Forward=1, Order=1
|
---|
| 43 | N GMRCTO,GMRCDG,GMRCSVC,GMRCOI
|
---|
| 44 | S GMRCTO=PURPOSE,GMRCDG=1
|
---|
| 45 | D SERV1^GMRCASV
|
---|
| 46 | S GMRCSVC=0
|
---|
| 47 | I '$D(^TMP("GMRCSLIST",$J)) S Y(1)="-1^No services found" Q ;DBIA 2426
|
---|
| 48 | F I=1:1 S GMRCSVC=$O(^TMP("GMRCSLIST",$J,GMRCSVC)) Q:+GMRCSVC=0 D
|
---|
| 49 | . S Y(I)=^TMP("GMRCSLIST",$J,GMRCSVC)
|
---|
| 50 | . S GMRCOI=$O(^ORD(101.43,"ID",$P(Y(I),U,1)_";99CON",0))
|
---|
| 51 | . S Y(I)=Y(I)_U_GMRCOI
|
---|
| 52 | Q
|
---|
| 53 | ;
|
---|
| 54 | SVCSYN(ORROOT,ORSTRT,ORWHY,ORSYN,ORIEN) ;;return CSLT services for GUI
|
---|
| 55 | ;Input:
|
---|
| 56 | ; ORROOT - passed in as the array to return results in
|
---|
| 57 | ; ORSTRT- service to begin building from
|
---|
| 58 | ; ORWHY - 0 for display, 1 for forwarding or ordering
|
---|
| 59 | ; ORSYN - Boolean: 1=return synonyms, 0=do not
|
---|
| 60 | ; ORIEN - Consult IEN (file 123) (OPTIONAL)
|
---|
| 61 | ;Output: Array formatted as follows-
|
---|
| 62 | ; svc ien^svc name or syn^parent^has children^svc usage^orderable item
|
---|
| 63 | N ORSVC,I,X,OI
|
---|
| 64 | S:+$G(ORSTRT)=0 ORSTRT=1
|
---|
| 65 | S:$G(ORWHY)="" ORWHY=1
|
---|
| 66 | S:$G(ORSYN)="" ORSYN=1
|
---|
| 67 | S ORROOT=$NA(^TMP("ORCSLT",$J))
|
---|
| 68 | D GUI^GMRCASV1(ORROOT,ORSTRT,ORWHY,ORSYN,$G(ORIEN))
|
---|
| 69 | S ORSVC=0
|
---|
| 70 | I '$D(@ORROOT) S @ORROOT@(1)="-1^No services found" Q
|
---|
| 71 | F I=1:1 S ORSVC=$O(@ORROOT@(ORSVC)) Q:+ORSVC=0 D
|
---|
| 72 | . S X=@ORROOT@(ORSVC)
|
---|
| 73 | . S OI=$O(^ORD(101.43,"ID",$P(X,U,1)_";99CON",0))
|
---|
| 74 | . I +OI>0 S @ORROOT@(ORSVC)=X_U_OI
|
---|
| 75 | Q
|
---|
| 76 | STATUS(Y) ; Returns a list of statuses currently in use
|
---|
| 77 | ;
|
---|
| 78 | N GMRCORST
|
---|
| 79 | S GMRCORST=0,Y(999)="999^OTHER^"
|
---|
| 80 | F S GMRCORST=$O(^ORD(100.01,GMRCORST)) Q:'+GMRCORST D
|
---|
| 81 | . I '$D(^GMR(123.1,"AC",GMRCORST)) S Y(999)=Y(999)_GMRCORST_"," Q
|
---|
| 82 | . Q:$$SCREEN^XTID(100.01,,GMRCORST_",") ;inactive VUID
|
---|
| 83 | . S Y(GMRCORST)=GMRCORST_U_$P(^ORD(100.01,GMRCORST,0),U,1)
|
---|
| 84 | Q
|
---|
| 85 | ;
|
---|
| 86 | MEDRSLT(ORY,GMRCO) ;Returns Medicine results plus TIU results
|
---|
| 87 | S ORY=$NA(^TMP("ORRSLT",$J))
|
---|
| 88 | D RT^GMRCGUIA(GMRCO,ORY)
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | SHOW513(ORY,GMRCO) ;CONSULTS SF513 DISPLAY IN GUI
|
---|
| 92 | D GUI^GMRCP5(.ORY,GMRCO)
|
---|
| 93 | Q
|
---|
| 94 | PRT513(Y,GMRCO,GMRCCHT,GMRCDEV) ; Print SF513 to VistA device from GUI
|
---|
| 95 | N ORSTATUS
|
---|
| 96 | D EN^GMRCP5(GMRCO,GMRCCHT,GMRCDEV,.ORSTATUS)
|
---|
| 97 | S Y=ORSTATUS
|
---|
| 98 | Q
|
---|
| 99 | WPRT513(ORY,GMRCO,GMRCCHT) ;Print SF513 to Windows device from GUI
|
---|
| 100 | N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORHANDLE
|
---|
| 101 | N IOM,IOSL,IOST,IOF,IOT,IOS
|
---|
| 102 | S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORHANDLE="ORQQCN2"
|
---|
| 103 | S ORY=$NA(^TMP(ORSUB,$J,1))
|
---|
| 104 | S ORHFS=$$HFS^ORWRP()
|
---|
| 105 | D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
|
---|
| 106 | I POP D Q
|
---|
| 107 | . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for SF513 print")
|
---|
| 108 | D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
|
---|
| 109 | N $ETRAP,$ESTACK
|
---|
| 110 | S $ETRAP="D ERR^ORWRP Q"
|
---|
| 111 | U IO
|
---|
| 112 | D PRNT^GMRCP5A(GMRCO,0,0,GMRCCHT,0)
|
---|
| 113 | D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
|
---|
| 114 | Q
|
---|
| 115 | SIGFIND(Y,ORIEN,ORFL,ORCOM,ORALRT,ORALTO,ORDATE) ;Significant findings
|
---|
| 116 | S Y=$$SFILE^GMRCGUIB(ORIEN,4,ORFL,"",DUZ,.ORCOM,ORALRT,ORALTO,ORDATE) ; "4"=SIG FIND ACTION
|
---|
| 117 | Q
|
---|
| 118 | ADMCOMPL(Y,ORIEN,ORFL,ORCOM,ORRESP,ORALRT,ORALTO,ORDATE) ; Admin users
|
---|
| 119 | ; Administrative complete action
|
---|
| 120 | S Y=$$SFILE^GMRCGUIB(ORIEN,10,ORFL,ORRESP,DUZ,.ORCOM,ORALRT,ORALTO,ORDATE) ; "10"=Admin Complete
|
---|
| 121 | Q
|
---|
| 122 | SVCLIST(ORY,FROM,DIR) ; Return a set of consult services in long list format
|
---|
| 123 | ; .ORY=returned list, FROM=text to $O from, DIR=$O direction,
|
---|
| 124 | N I,IEN,CNT,Y,ORTMP,ORSVC,ORSTR
|
---|
| 125 | S I=0,CNT=44,ORSVC=""
|
---|
| 126 | D SVCTREE^ORQQCN2(.Y,1)
|
---|
| 127 | F I=1:1 S ORSVC=$P($G(Y(I)),U,2) Q:ORSVC="" D
|
---|
| 128 | . S ORTMP(ORSVC)=Y(I)
|
---|
| 129 | F I=1:1 Q:I=CNT S FROM=$O(ORTMP(FROM),DIR) Q:FROM="" D
|
---|
| 130 | . S ORSTR=ORTMP(FROM)
|
---|
| 131 | . S ORY(I)=ORSTR
|
---|
| 132 | Q
|
---|
| 133 | GETCTXT(Y,ORUSER) ; Returns current view context for user
|
---|
| 134 | S Y=$$GET^XPAR("ALL","ORCH CONTEXT CONSULTS",1)
|
---|
| 135 | Q
|
---|
| 136 | SAVECTXT(Y,ORCTXT) ; Save new view preferences for user
|
---|
| 137 | N TMP
|
---|
| 138 | S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1)
|
---|
| 139 | I TMP'="" D Q
|
---|
| 140 | . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
|
---|
| 141 | D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT CONSULTS",1,ORCTXT)
|
---|
| 142 | Q
|
---|
| 143 | ;
|
---|
| 144 | DEFRFREQ(ORY,ORSVC,ORDFN,RESOLVE) ;Return default reason for request for service
|
---|
| 145 | ; ORSVC=pointer to file 123.5
|
---|
| 146 | ; ORDFN=patient, if RESOLVE=1
|
---|
| 147 | ; RESOLVE=1 to resolve boilerplate, 0 to not resolve
|
---|
| 148 | Q:+$G(ORSVC)=0
|
---|
| 149 | I +RESOLVE,(+$G(ORDFN)=0) Q
|
---|
| 150 | S ORY=$NA(^TMP("ORREQ",$J))
|
---|
| 151 | S:$G(RESOLVE)="" RESOLVE=0
|
---|
| 152 | D GETDEF^GMRCDRFR(.ORY,ORSVC,ORDFN,RESOLVE)
|
---|
| 153 | K @ORY@(0)
|
---|
| 154 | Q
|
---|
| 155 | EDITDRFR(ORY,ORSVC) ; Allow editing of reason for request?
|
---|
| 156 | S ORY=$$REAF^GMRCDRFR(ORSVC)
|
---|
| 157 | Q
|
---|
| 158 | SVCIEN(ORY,ORIEN) ;Given orderable item file entry, return IEN in 123.5, OR -1 IF INACTIVE IN 101.43
|
---|
| 159 | N X1
|
---|
| 160 | I '$D(^ORD(101.43,ORIEN)) S ORY=-1 Q
|
---|
| 161 | S X1=$G(^ORD(101.43,ORIEN,.1))
|
---|
| 162 | I +X1,+X1<$$NOW^XLFDT S ORY=-1 Q
|
---|
| 163 | S ORY=$P($$USID^ORWDXC(ORIEN),U,4)
|
---|
| 164 | Q
|
---|
| 165 | PROVDX(ORY,ORIEN) ;Return provisional dx prompting info for service
|
---|
| 166 | S ORY=$$PROVDX^GMRCUTL1(ORIEN)
|
---|
| 167 | Q
|
---|
| 168 | PREREQ(ORY,ORSVC,ORDFN) ;Returns prequisites for ordering
|
---|
| 169 | Q:(+$G(ORSVC)=0)!(+$G(ORDFN)=0)
|
---|
| 170 | S ORY=$NA(^TMP("ORPREREQ",$J))
|
---|
| 171 | D PREREQ^GMRCUTL1(.ORY,ORSVC,ORDFN,0) ;0=RESOLVE OBJECTS
|
---|
| 172 | K @ORY@(0)
|
---|
| 173 | Q
|
---|
| 174 | UNRSLVD(ORY,ORDFN) ;Returns true if unresolved consults for user/pt
|
---|
| 175 | ;S ORY=0
|
---|
| 176 | ;Q:+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")=0
|
---|
| 177 | ;S ORY=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
|
---|
| 178 | ;Q
|
---|
| 179 | S $P(ORY,U,1)=+$$ANYPENDG^GMRCTIU(ORDFN,DUZ) ;DBIA #3473
|
---|
| 180 | S $P(ORY,U,2)=+$$GET^XPAR("ALL","ORWOR SHOW CONSULTS",1,"I")
|
---|
| 181 | Q
|
---|