source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCASF.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1GMRCASF ;SLC/DLT - Significant Findings Action ;7/11/03 13:28
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,22,29,35**;DEC 27, 1997
3SF(GMRCO) ;Evaluate Significant Findings and update accordingly
4 ;GMRCO is the selected consult
5 N GMRCQIT,GMRCLCK
6 I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
7 I '+($G(GMRCO)) D END Q
8 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
9 . N DIR
10 . W !,"The requesting facility may not take this action on an "
11 . W "inter-facility consult."
12 . S DIR(0)="E" D ^DIR
13 . D END
14 I '$$LOCK^GMRCA1(GMRCO) D END Q
15 S GMRCLCK=1
16 ;
17 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
18 N GMRC,GMRCSTS,GMRCSF,GMRCSFO,GMRCORTX,GMRCDR
19 S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:GMRC(0)=""
20 ;
21 S GMRCSFO=$P(GMRC(0),"^",19)
22 W !!,"Current Significant Findings = "_$S(GMRCSFO="U":"Unknown",GMRCSFO="Y":"Yes",GMRCSFO="N":"No",1:"not entered yet"),!!
23 S GMRCSF=$$GETSIGF(GMRCSFO)
24 I GMRCSF=0 D END Q
25 ; If no change in old and new value ask if should continue
26 I GMRCSF=GMRCSFO D I 'Y D END Q
27 . W !,"The old and new Significant Findings are the same."
28 . N DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT
29 . S DIR("A")="Do you want to proceed with this action"
30 . S DIR(0)="Y"
31 . S DIR("B")="NO"
32 . D ^DIR
33 . I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S Y=0 Q
34 . I Y=0 Q
35 ;
36 ;Update last action and sig findings but don't change the status
37 S GMRCSTS=$P(GMRC(0),"^",12),GMRCA=4
38 S GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
39 D STATUS^GMRCP
40 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG),END Q
41 ;
42 ;GMRCOM=1 tells AUDIT^GMRCP to do the word-processing logic
43 ;If an actual comment is added, $P(GMRCOM,"^",2)=1 (send alert),
44 ; if not GMRCOM=1 and no '^' exists (do not send alert)
45 S GMRCOM=1 D AUDIT^GMRCP
46 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG),END Q
47 ;
48 I GMRCSTS=2 D EN^GMRCHL7($P(^GMR(123,GMRCO,0),U,2),GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),,,$G(GMRCAD))
49 D SETORTX
50 I GMRCSTS=2 D SENDALRT(GMRCORTX) Q
51 I +$P(GMRCOM,"^",2) D
52 . W !,"An alert with the following text will be sent if recipients are selected: "
53 . W !," "_GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
54 . W !
55 . I GMRCSTS'=2 W !,"or the alert will be sent when the order is completed.",!
56 . I $P($G(^GMR(123,GMRCO,12)),U,5)="F" D
57 . W !!,"The ordering provider for this inter-facility consult will "
58 . W "automatically be ",!,"notified.",!
59 . D PROCALRT^GMRCACMT(GMRCORTX,1,4,GMRCO)
60 . ;For consults not completed, the original provider may be deleted from
61 . ;the recipient list for the alert.
62 D END
63 Q
64 ;
65SETORTX ;Set prefix text for the alert
66 S GMRCORTX=$S(GMRCSF="N":"No ",GMRCSF="Y":"",1:"Unknown ")
67 S GMRCORTX=GMRCORTX_"Sig Findings for "_$P($G(^ORD(100.01,+GMRCSTS,0)),"^",2)_" consult " Q
68 Q
69 ;
70SENDALRT(GMRCORTX) ;Send to the requesting provider
71 N GMRCRP,GMRCADUZ,GMRCDELR
72 S GMRCRP=$P($G(^GMR(123,+GMRCO,0)),U,14) ;requesting clinician
73 I +GMRCRP S GMRCADUZ(+GMRCRP)=""
74 W !,"Alert will be sent to Requesting Provider: "_$P($G(^VA(200,+GMRCRP,0)),U,1)
75 S GMRCDELR=0
76 D ANDTO^GMRCACMT
77 D SENDMSG^GMRCACMT(23,+GMRCO)
78 ;Sig Findings uses the CONSULT/REQUEST RESOLUTION (23) notification
79 Q
80 ;
81GETSIGF(GMRCSFO) ;Get the significant findings
82 ;GMRCSFO is the old significant findings value
83 N DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT
84 S DIR(0)="123,15"
85 S DIR("B")=GMRCSFO
86 S:DIR("B")="" DIR("B")="unknown"
87 S DIR("A")="Are there significant findings? (Y/N/U)"
88 D ^DIR
89 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q 0
90 Q Y
91 ;
92END ;cleanup variables
93 I $G(GMRCLCK) D UNLOCK^GMRCA1(GMRCO)
94 K GMRCO,GMRCA,GMRCMSG,GMRCOM,GMRCSEL,GMRCERR,GMRCERMS
95 I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
96 S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
97 Q
Note: See TracBrowser for help on using the repository browser.