source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP.m@ 1261

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1GMRCP ;SLC/DLT,DCM - Message audit and status process ;4/19/01 11:52
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,17,22,27,53,55**;DEC 27, 1997;Build 4
3 ;Processing action on Generic Requests/Consults from OE/RR
4MSG(GMRCDFN,GMRCALRM,GMRCIFN,ORN,GMRCADUZ,FLG) ;send alert notification information to OERR for notification or update
5 ;GMRCDFN=patient's DFN GMRCORFN=OR file # ^OR(100,GMRCORFN
6 ;GMRCALRM=alert message to be displayed with alert
7 ;GMRCIFN=internal file number of consult in file 123
8 ;GMRCADUZ=set in call to EN^GMRCT=array of providers who will be alerted
9 ;FLG=1 if need to get list of service's providers, 0 if service dc'd.
10 ;ORN=IFN from file ^ORD(100.9, for consult notification action
11 N GMRCSS,GMRCORFN
12 S GMRCORFN=$P(^GMR(123,+GMRCIFN,0),"^",3)
13 S GMRCSS=$P($G(^GMR(123,+GMRCIFN,0)),"^",5)
14 I FLG,GMRCSS D EN^GMRCT(GMRCSS)
15 I $P($G(^GMR(123,+GMRCIFN,12)),U,5)="P" D
16 . Q:ORN=27 ; don't notify requestor if a new order they placed, duh...
17 . I DUZ=+$P(^GMR(123,+GMRCIFN,0),U,14) Q ; don;t alert on own actions
18 . S GMRCADUZ(+$P(^GMR(123,+GMRCIFN,0),U,14))=""
19 I FLG,$P(^GMR(123,+GMRCIFN,0),"^",11) S GMRCADUZ($P(^(0),"^",11))=""
20 S:'$D(GMRCADUZ) GMRCADUZ=""
21 N X S X="" F S X=$O(GMRCADUZ(X)) Q:((X="")!(X=DUZ)) I +X=DUZ K GMRCADUZ(X) ;Don't send alert to user generating alert
22 D EN^ORB3(ORN,GMRCDFN,GMRCORFN,.GMRCADUZ,GMRCALRM,GMRCIFN)
23 Q
24AUDIT ;Build processing activity audit trail multiple.
25 S GMRCDT=$$NOW^XLFDT
26AUDIT0 ;alternate entry with date already defined
27 L +^GMR(123,+GMRCO,40):5 I '$T S GMRCUT=1,GMRCERR=1,GMRCERMS="Activity Trail Not filed - Consult In Use By Another User." L -^GMR(123,+GMRCO,40) Q
28 S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^"
29 S DA=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
30 S $P(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
31AUDIT1 ;entry when the DA is not incremented (INCOMPLETE RPT writeovers)
32 S GMRCORNP=$G(GMRCORNP) S:'$D(GMRCOM) GMRCOM=0
33 S GMRCDEV=$G(GMRCDEV),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA)
34 S GMRCAD=$S('$D(GMRCAD):GMRCDT,1:GMRCAD)
35 S GMRCRSLT=$G(GMRCRSLT) ;Added result with GMRC*3.0*4
36 S DIE="^GMR(123,"_+GMRCO_",40,",DA(1)=+GMRCO
37 I '$D(^GMR(123,DA(1),40,DA,0)) D
38 . S DR=".01////^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP"
39 . I GMRCA'=22 S DR=DR_";4////^S X=DUZ" ;if it's a print, pkg did it
40 . S DR=DR_";6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
41 E D
42 . ;DR string on .01 allows write over, rather than forced new entry
43 . S DR=".01///^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=DUZ;6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
44 ;Added result to the DR string
45 D ^DIE
46COMMENT ;Enter comment
47 I +$G(GMRCOM) S GMRCOM(0)=DA D
48 . W !,"Enter COMMENT..."
49 . N DIC,DWPK,DWLW,DIWESUB
50 . S DIC=DIE_DA_",1,",DWPK=1,DWLW=74
51 . S DIWESUB="COMMENTS" D EN^DIWE
52 . I $P($G(^GMR(123.1,+$P(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="ADDED COMMENT",'$O(^GMR(123,+GMRCO,40,DA,0)) D Q
53 .. S DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
54 .. Q
55 . I $P($G(^GMR(123.1,+$P(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="COMPLETE/UPDATE",$P($G(^GMR(123,+GMRCO,40,DA,0)),U,9)="" D
56 .. N GMRCMT,GMRCMT1
57 .. S (GMRCMT,GMRCMT1)=0
58 .. F S GMRCMT=$O(^GMR(123,+GMRCO,40,DA,1,GMRCMT)) Q:GMRCMT="" D Q:GMRCMT1=1
59 ... I $TR($G(^GMR(123,+GMRCO,40,DA,1,GMRCMT,0))," ","")'="" S GMRCMT1=1
60 .. I 'GMRCMT1 D G:'GMRCQUIT COMMENT Q
61 ... S GMRCQUIT=0
62 ... W !!,"A comment is required to complete this request!",!
63 ... D WP^DIE(123.02,DA_","_+GMRCO_",",5,,"@")
64 ... K DIR
65 ... S DIR("A")="Type 'Q' to quit or 'C' to continue entering a comment:"
66 ... S DIR("B")="C"
67 ... S DIR(0)="S^C:CONTINUE;Q:QUIT"
68 ... S DIR("?")="Type 'Q' if you would like to abort completion of this Consult/Procedure."
69 ... S DIR("?",1)="Type 'C' or press <RETURN> to re-enter your comments."
70 ... D ^DIR K DIR I Y'="C" S GMRCQUIT=1,DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
71 . I '$G(DA) S DA=D0
72 . I $D(^GMR(123,+GMRCO,40,DA,0)),$O(^GMR(123,+GMRCO,40,DA,0)) S $P(GMRCOM,"^",2)=1
73 . Q
74 L -^GMR(123,+GMRCO,40)
75 ; if an IFC, call event handler to generate a msg to remote site
76 I $D(^GMR(123,GMRCO,12)),$L($P(^(12),U,5)) D
77 . Q:'$D(^GMR(123,GMRCO,40,DA))
78 . D TRIGR^GMRCIEVT(GMRCO,DA)
79 ;
80 K DIE,DA,DR,GMRCDEV,GMRCFF,GMRCPA,X,% Q
81 ;
82STATUS ;Update the status for the Request/Consultation File
83 K GMRCQUT
84 Q:'$D(GMRCSTS)!('$D(GMRCA))
85 S DIE=123,DA=+GMRCO
86 I $D(GMRCDR),$L(GMRCDR) S DR=GMRCDR
87 E S DR="8////^S X=GMRCSTS;9////^S X=GMRCA"
88 L +^GMR(123,GMRCO):2 I '$T S GMRCQUT=1,GMRCERR=1,GMRCERMS="Unable to update status and last action - Consult In Use By Another User." Q
89 D ^DIE
90 L -^GMR(123,+GMRCO)
91 K DIE,DA,DR,GMRCDR
92 Q
Note: See TracBrowser for help on using the repository browser.