source: WorldVistAEHR/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVOB.m@ 642

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1ANRVOB ; HOIFO/CED - Supports VIST GUI OUTCOMES ; [01-07-2003 12:20]
2 ;;4.0;VISUAL IMPAIRMENT SERVICE TEAM;**5**;JUN 03, 2002
3ADDTXT(RESULTS,SUBREC,TOPREC,STATUS,OTCTXT) ; [Procedure] Uploads section text
4 ; Input parameters
5 ; 1. RESULTS [Literal/Required] No description
6 ; 2. SUBREC [Literal/Required] No description
7 ; 3. TOPREC [Literal/Required] No description
8 ; 4. STATUS [Literal/Required] No description
9 ; 5. OTCTXT [Literal/Required] No description
10 ;
11 N UPSTAT
12 K ^TMP("OTC",$J)
13 M ^TMP("OTC",$J,"OTCTXT")=OTCTXT
14 D WP^DIE(2048.01,SUBREC_","_TOPREC_",",1,"K",$NA(^TMP("OTC",$J,"OTCTXT")))
15 S ^ANRV(2048,TOPREC,1,SUBREC,0)=SUBREC_U_STATUS ; update status
16 I $DATA(DIERR) S RESULTS(0)="-1^"_DIERR
17 E S RESULTS(0)="1^Section Updated"
18 K ^TMP("OTC",$J)
19 Q
20 ;
21GETREC(RESULTS,PTDFN) ; [Procedure] Get top record and sub records
22 ; Input parameters
23 ; 1. RESULTS [Literal/Required] No description
24 ; 2. PTDFN [Literal/Required] No description
25 ;
26 N X,Y,IEN,IDATE,DATE,TIME,STATUS,TYPE,S1,S1STAT,S2,S2STAT,S3,S3STAT,S4,S4STAT,S5,S5STAT,S6,S6STAT
27 K ^TMP($J)
28 I '$D(^ANRV(2048,"B",PTDFN)) S RESULTS(0)="^0^No Outcome's On Record" Q
29 F IEN=0:0 S IEN=$O(^ANRV(2048,"B",PTDFN,IEN)) Q:'IEN D
30 .S IDATE=$P($G(^ANRV(2048,IEN,0)),U,2,2) ;internal date
31 .S STATUS=$P($G(^ANRV(2048,IEN,0)),U,3,3) ;status(incomplete,complete,partial)
32 .S TYPE=$P($G(^ANRV(2048,IEN,0)),U,4,4) ;type(Pre or Post)
33 .S TIME=$E(IDATE,9,10)_":"_$E(IDATE,11,12) ;time top record created
34 .S:TIME=":" TIME="00:00" ;put it in readable format for user
35 .S Y=IDATE X ^DD("DD") S DATE=Y ;convertinator
36 .S S1=$P($G(^ANRV(2048,IEN,1,1,0)),U,1) ;section 1
37 .S S1STAT=$P($G(^ANRV(2048,IEN,1,1,0)),U,2) ;section 1 status
38 .S S2=$P($G(^ANRV(2048,IEN,1,2,0)),U,1) ;section 2
39 .S S2STAT=$P($G(^ANRV(2048,IEN,1,2,0)),U,2) ;section 2 status
40 .S S3=$P($G(^ANRV(2048,IEN,1,3,0)),U,1) ;section 3
41 .S S3STAT=$P($G(^ANRV(2048,IEN,1,3,0)),U,2) ;section 3 status
42 .S S4=$P($G(^ANRV(2048,IEN,1,4,0)),U,1) ;section 4
43 .S S4STAT=$P($G(^ANRV(2048,IEN,1,4,0)),U,2) ;section 4 status
44 .S S5=$P($G(^ANRV(2048,IEN,1,5,0)),U,1) ;section 5
45 .S S5STAT=$P($G(^ANRV(2048,IEN,1,5,0)),U,2) ;section 5 status
46 .S S6=$P($G(^ANRV(2048,IEN,1,6,0)),U,1) ;section 6
47 .S S6STAT=$P($G(^ANRV(2048,IEN,1,6,0)),U,2) ;section 6 status
48 .S RESULTS(IEN)=1_U_IEN_U_IDATE_U_DATE_U_STATUS_U_TYPE_U_S1_U_S1STAT_U_S2_U_S2STAT_U_S3_U_S3STAT_U_S4_U_S4STAT_U_S5_U_S5STAT_U_S6_U_S6STAT
49 I $DATA(DIERR) S @RESULTS@(0)="-1^"_DIERR
50 Q
51 ;
52GETSEC(RESULTS,RECORD) ; [Procedure] Get Outcome Section
53 ; Input parameters
54 ; 1. RESULTS [Literal/Required] No description
55 ; 2. RECORD [Literal/Required] No description
56 ;
57 D GETS^DIQ(2048,+RECORD,".01;.02","","RESULTS","DIERR")
58 I $DATA(DIERR) S @RESULTS@(0)="-1^["_DIERR_"]"
59 Q
60 ;
61GETTXT(RESULTS,SUBREC,TOPREC) ; [Procedure] Gets the Outcome Text
62 ; Input parameters
63 ; 1. RESULTS [Literal/Required] No description
64 ; 2. SUBREC [Literal/Required] No description
65 ; 3. TOPREC [Literal/Required] No description
66 ;
67 S RESULTS=$$GET1^DIQ(2048.01,SUBREC_","_TOPREC_",",1,"","RESULTS")
68 Q
69 ;
70MKREC(RESULTS,PTDFN,STATUS,TYPE) ; [Procedure] Creates Outcome record
71 ; Input parameters
72 ; 1. RESULTS [Literal/Required] No description
73 ; 2. PTDFN [Literal/Required] No description
74 ; 3. STATUS [Literal/Required] No description
75 ; 4. TYPE [Literal/Required] No description
76 ;
77 K ^TMP($J)
78 N X,Y,I,NEWREC,NOW,NEWIEN,ERR
79 D NOW^%DTC S NOW=%
80 S NEWREC(2048,"+1,",.01)=PTDFN ; patient ien
81 S NEWREC(2048,"+1,",.02)=NOW ; date and time
82 S NEWREC(2048,"+1,",.03)=STATUS ; I=inpatient, O=outpatient, Z=other
83 S NEWREC(2048,"+1,",.04)=TYPE ; R=Pre or O=Post Outcome
84 D UPDATE^DIE("","NEWREC","NEWIEN")
85 S ^ANRV(2048,NEWIEN(1),1,0)="^2048.01,.01P^^"
86 F X=0:0 S X=$O(^ANRV(2048.1,X)) Q:'X D
87 .S ^ANRV(2048,NEWIEN(1),1,X,0)=X
88 .S ^ANRV(2048,NEWIEN(1),1,"B",X,X)=""
89 S RESULTS(0)="1"_U_NEWIEN(1)
90 I $DATA(DIERR) S RESULTS(0)="-1^"_U_DIERR
91 Q
92 ;
93RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC Entry.
94 ; Input parameters
95 ; 1. RESULTS [Literal/Required] No description
96 ; 2. OPTION [Literal/Required] No description
97 ; 3. DATA [Literal/Required] No description
98 ;
99 S RESULTS=$NA(^TMP("ANRVUSER",$J)) K @RESULTS
100 D:$T(@OPTION)]"" @OPTION
101 S:'$D(@RESULTS) @RESULTS@(0)="-1^No results returned"
102 D CLEAN^DILF
103 Q
104 ;
105SNDTXT(RESULTS,ANRVCMD,DATA) ; [Procedure] Send completed Outcome
106 ; Input parameters
107 ; 1. RESULTS [Literal/Required] No description
108 ; 2. ANRVCMD [Literal/Required] No description
109 ; 3. DATA [Literal/Required] No description
110 ;
111 S RESULTS=$NA(^TMP($J)),^TMP($J,0)="-1^Unknown Error"
112 D:ANRVCMD="CREATE"
113 .K ^TMP("ANRVMAIL",$J)
114 .S ^TMP($J,0)="1^Message '"_$J_"' created."
115 D:ANRVCMD="APPEND"
116 .D:$G(DATA)]""
117 ..S Y=$O(^TMP("ANRVMAIL",$J,"TEXT",""),-1)+1
118 ..S ^TMP("ANRVMAIL",$J,"TEXT",Y,0)=DATA
119 .S X="DATA"
120 .F S X=$Q(@X) Q:X="" D
121 ..S Y=$O(^TMP("ANRVMAIL",$J,"TEXT",""),-1)+1
122 ..S ^TMP("ANRVMAIL",$J,"TEXT",Y,0)=@X
123 .S Y=+$O(^TMP("ANRVMAIL",$J,"TEXT",""),-1)
124 .S ^TMP("ANRVMAIL",$J,"TEXT",0)="^^"_Y
125 .S ^TMP($J,0)="1^Text appended."
126 D:ANRVCMD="SUBJECT"
127 .S ^TMP("ANRVMAIL",$J,"SUBJECT")=DATA
128 .S ^TMP($J,0)="1^Message subject set to '"_DATA_"'"
129 D:ANRVCMD="SENDTO"
130 .D:$G(DATA)]""
131 ..S Y=$O(^TMP("ANRVMAIL",$J,"SENDTO",""),-1)+1
132 ..S ^TMP("ANRVMAIL",$J,"SENDTO",Y)=DATA
133 .S X="DATA"
134 .F S X=$Q(@X) Q:X="" D
135 ..S Y=$O(^TMP("ANRVMAIL",$J,"SENDTO",""),-1)+1
136 ..S ^TMP("ANRVMAIL",$J,"SENDTO",Y)=@X
137 .S ^TMP($J,0)="1^Recipients Added."
138 D:ANRVCMD="EXECUTE"
139 .S XMSUB=$G(^TMP("ANRVMAIL",$J,"SUBJECT"),"No subject")
140 .S XMTEXT="^TMP(""ANRVMAIL"",$J,""TEXT"","
141 .F X=0:0 S X=$O(^TMP("ANRVMAIL",$J,"SENDTO",X)) Q:'X D
142 ..S XMY(^(X))=""
143 .D ^XMD
144 .S ^TMP($J,0)="1^Message Sent. ID: "_+$G(XMZ)
145 Q
146 ;
147UPREC(RESULTS,TOPREC,STATUS) ; [Procedure] Update Top Record Status
148 ; Input parameters
149 ; 1. RESULTS [Literal/Required] No description
150 ; 2. TOPREC [Literal/Required] No description
151 ; 3. STATUS [Literal/Required] No description
152 ;
153 N MYFDA
154 S MYFDA(2048,TOPREC_",",.03)=STATUS
155 D FILE^DIE("","MYFDA")
156 I $DATA(DIERR) S RESULTS="-1^"_DIERR
157 E S RESULTS="1^SECTION UPDATED"
158 Q
159 ;
160ADD(X) ; [Function] Adds data to @Results@
161 ; Input parameters
162 ; 1. X [Literal/Required] No description
163 ;
164 S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
165 Q
166 ;
Note: See TracBrowser for help on using the repository browser.