source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCAD31.m@ 1639

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1GMRCAD31 ;SLC/JFR - admin corrections on cons. activities; 2/19/03 14:09
2 ;;3.0;CONSULT/REQUEST TRACKING;**32**;DEC 27, 1997
3EN ;Start prompting and prepare to build a list
4 N GMRCIEN
5 S GMRCIEN=$$GETCSLT
6 I 'GMRCIEN W !,"No Consult selected." Q
7 I '$$CKACTS(GMRCIEN) D G EN
8 . W !,"The request has no activities meeting editing criteria"
9 . H 2
10 D BLDLST(GMRCIEN)
11 D EN^VALM("GMRC ADM31")
12 Q
13 ;
14GETCSLT() ;
15 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
16 D EN^DDIOL("You may only select IFC requests ordered at your facility")
17 D EN^DDIOL(" ")
18 S DIR(0)="PAO^123"
19 S DIR("?")="Select an inter-facility request being performed elsewhere"
20 S DIR("A")="Select Consult #: "
21 S DIR("S")="I $P($G(^GMR(123,+Y,12)),U,5)=""P"""
22 D ^DIR
23 I '$G(Y) Q ""
24 Q +Y
25 Q
26 ;
27NEWCSLT ; select a new consult to work on
28 D FULL^VALM1
29 N GMRCIEN
30 S GMRCIEN=$$GETCSLT
31 I 'GMRCIEN D D INIT Q
32 . N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
33 . S DIR(0)="E" D ^DIR
34 . Q
35 I '$$CKACTS(GMRCIEN) D D INIT Q
36 . W !,"The request has no activities meeting editing criteria"
37 D EXIT,BLDLST(GMRCIEN),INIT
38 Q
39 ;
40SELACT ; choose which action to edit
41 D FULL^VALM1
42 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,GMRCO
43 D EN^DDIOL("You may only select one of the listed activities.")
44 D EN^DDIOL(" ")
45 S DIR(0)="NAO^2:50"
46 S DIR("A")="Select an activity from the list by number: "
47 D ^DIR
48 I $D(DIRUT) S VALMBCK="R" Q
49 I '$D(^TMP("GMRCADM",$J,"B",+Y)) D G SELACT
50 . D EN^DDIOL("That is not a listed activity",,"!!?5")
51 S GMRCO=$G(^TMP("GMRCADM",$J,"CSLT"))
52 D FIX(GMRCO,+Y)
53 D EXIT,BLDLST(GMRCO),INIT
54 S VALMBCK="R"
55 Q
56 ;
57BLDLST(GMRCDA) ;build the list for LM
58 ; Input:
59 ; GMRCDA = ien from file 123
60 ;
61 K ^TMP("GMRCADM",$J)
62 N PTNM,PTSSN,REMSIT,REMNUM,GMRCCT,TAB
63 S ^TMP("GMRCADM",$J,"CSLT")=GMRCDA
64 S GMRCCT=1,TAB=$$REPEAT^XLFSTR(" ",29)
65 S PTNM="Patient name: "_$$GET1^DIQ(123,GMRCDA,.02,"E")
66 S PTSSN="SSN: "_$$GET1^DIQ(2,$P(^GMR(123,GMRCDA,0),U,2),.09)
67 S REMSIT="Receiving Site: "
68 S REMSIT=REMSIT_$$GET1^DIQ(4,$P(^GMR(123,GMRCDA,0),U,23),.01)
69 S REMNUM="Remote Consult #: "_$P(^GMR(123,GMRCDA,0),U,22)
70 S ^TMP("GMRCADM",$J,GMRCCT,0)="Consult #: "_GMRCDA
71 S GMRCCT=GMRCCT+1
72 S ^TMP("GMRCADM",$J,GMRCCT,0)=PTNM_" "_PTSSN
73 S GMRCCT=GMRCCT+1
74 S ^TMP("GMRCADM",$J,GMRCCT,0)=REMSIT_" "_REMNUM
75 S GMRCCT=GMRCCT+1
76 S ^TMP("GMRCADM",$J,GMRCCT,0)="",GMRCCT=GMRCCT+1
77 S ^TMP("GMRCADM",$J,GMRCCT,0)="Facility",GMRCCT=GMRCCT+1
78 S ^TMP("GMRCADM",$J,GMRCCT,0)=" Activity"_$E(TAB,1,16)_"Date/Time/Zone"_$E(TAB,1,6)_"Responsible Person"_$E(TAB,1,2)_"Entered By",GMRCCT=GMRCCT+1
79 S ^TMP("GMRCADM",$J,GMRCCT,0)=$$REPEAT^XLFSTR("-",79)
80 S GMRCCT=GMRCCT+1
81 N ACTV
82 S ACTV=0
83 F S ACTV=$O(^GMR(123,GMRCDA,40,ACTV)) Q:'ACTV D
84 . N ACTYPE
85 . S ACTYPE=$P(^GMR(123,GMRCDA,40,ACTV,0),U,2)
86 . Q:ACTYPE'=17&(ACTYPE'=4) ;only FWD and SF are affected
87 . Q:'$D(^GMR(123,GMRCDA,40,ACTV,2)) ;only remote activities
88 . Q:'$O(^GMR(123,GMRCDA,40,ACTV,1,1))
89 . S ^TMP("GMRCADM",$J,"B",ACTV)=GMRCCT
90 . S ^TMP("GMRCADM",$J,GMRCCT,0)=" Act. #: "_ACTV,GMRCCT=GMRCCT+1
91 . D BLDALN^GMRCSLM4(GMRCDA,ACTV)
92 . M ^TMP("GMRCADM",$J)=^TMP("GMRCR",$J,"DT")
93 . K ^TMP("GMRCR",$J,"DT")
94 . S ^TMP("GMRCADM",$J,GMRCCT,0)="",GMRCCT=GMRCCT+1
95 . Q
96 Q
97 ;
98INIT ;
99 S VALMCNT=$O(^TMP("GMRCADM",$J," "),-1)
100 S VALMBG=1
101 S VALMBCK="R"
102 Q
103 ;
104EXIT ;
105 K ^TMP("GMRCADM",$J)
106 S VALMBCK="Q"
107 Q
108 ;
109HDR ;
110 S VALMHDR(1)=$$CJ^XLFSTR(("Consult #:"_^TMP("GMRCADM",$J,"CSLT")),80)
111 Q
112CKACTS(CSLT) ;assure that there is at least one activity meeting criteria
113 ; Input:
114 ; CSLT = ien from file 123
115 ;
116 N ACTV,OK
117 S ACTV=0,OK=0
118 F S ACTV=$O(^GMR(123,CSLT,40,ACTV)) Q:'ACTV!(OK=1) D
119 . N ACTYPE
120 . S ACTYPE=$P(^GMR(123,CSLT,40,ACTV,0),U,2)
121 . I ACTYPE=17 S OK=1 ; FWD action
122 . I ACTYPE=4 S OK=1 ; SF action
123 . I OK,'$D(^GMR(123,CSLT,40,ACTV,2)) S OK=0 ;only remote activities
124 . I OK,'$O(^GMR(123,CSLT,40,ACTV,1,1)) S OK=0 ;only those with comments
125 Q OK
126 ;
127FIX(GMRCDA,GMRCACT) ;do the admin correction on bad IFC comments
128 ; GMRCDA = ien from file 123
129 ; GMRCACT = ien within 40 multiple for activity
130 ;
131 I '$D(^GMR(123,GMRCDA,40,1)) D Q
132 . W !,"No comment there to correct"
133 K ^TMP("GMRCOCMT",$J)
134 M ^TMP("GMRCOCMT",$J)=^GMR(123,GMRCDA,40,GMRCACT,1)
135 W !!
136 N DIE,DR,DA,CHGD
137 S CHGD=0
138 S DA=GMRCACT,DA(1)=GMRCDA,DR=5,DIE="^GMR(123,"_DA(1)_",40,"
139 D ^DIE
140 I $O(^GMR(123,GMRCDA,40,GMRCACT,1," "),-1)'=$O(^TMP("GMRCOCMT",$J," "),-1) S CHGD=1
141 I 'CHGD D
142 . N I S I=0
143 . F S I=$O(^GMR(123,GMRCDA,40,GMRCACT,1,I)) Q:'I!(CHGD) D
144 .. I ^GMR(123,GMRCDA,40,GMRCACT,1,I,0)'=^TMP("GMRCOCMT",$J,I,0) S CHGD=1
145 .. Q
146 I 'CHGD W !,"No comment modification made!",!
147 I CHGD D AUDIT(GMRCDA,GMRCACT,$NA(^TMP("GMRCOCMT",$J)))
148 K ^TMP("GMRCOCMT",$J)
149 Q
150 ;
151AUDIT(GMRCO,GMRCAC,ARRAY) ;make new audit trail activity w/old and new
152 ;Input:
153 ; GMRCO = ien from file 123
154 ; GMRCAC = IEN WITHIN 40 MULTIPLE
155 ; ARRAY = array containing the old comment
156 N GMRCA,GMRCAD,GMRCMT,GMRCDA,DA,NUM,I
157 N ACTYPE,ACTWHO,ACTRESP,ACTWHEN
158 I '$G(GMRCO) Q
159 ; load up particulars about edited activity, then load old comment
160 ; then load up new comment in GMRCMT local array
161 S ACTYPE=$$GET1^DIQ(123.1,$P(^GMR(123,GMRCO,40,GMRCAC,0),U,2),.01)
162 S ACTWHO=$P(^GMR(123,GMRCO,40,GMRCAC,2),U)
163 S ACTRESP=$P(^GMR(123,GMRCO,40,GMRCAC,2),U,2)
164 D ;GET VALUE OF ACTWHEN
165 . N X
166 . S X=$P(^GMR(123,GMRCO,40,GMRCAC,2),U,5) D REGDTM^GMRCU
167 . S ACTWHEN=X_" "_$P(^GMR(123,GMRCO,40,GMRCAC,2),U,3)
168 S NUM=1
169 S GMRCMT(NUM)=" ",NUM=NUM+1
170 S GMRCMT(NUM)="The "_ACTYPE_" action, added "_ACTWHEN_" by",NUM=NUM+1
171 S GMRCMT(NUM)=ACTWHO_" "_$S($L(ACTRESP):("for "_ACTRESP),1:"")_","
172 S GMRCMT(NUM)=GMRCMT(NUM)_" has been administratively corrected."
173 S NUM=NUM+1,GMRCMT(NUM)=" ",NUM=NUM+1
174 S GMRCMT(NUM)="The comment was corrected from:",NUM=NUM+1
175 S GMRCMT(NUM)=" ",NUM=NUM+1
176 S I=0 ;load up old comment
177 F S I=$O(^TMP("GMRCOCMT",$J,I)) Q:'I D
178 . S GMRCMT(NUM)=^TMP("GMRCOCMT",$J,I,0),NUM=NUM+1
179 S GMRCMT(NUM)=" ",NUM=NUM+1
180 S GMRCMT(NUM)="The comment was corrected to: ",NUM=NUM+1
181 S GMRCMT(NUM)=" ",NUM=NUM+1
182 S I=0 ;load up current comment
183 F S I=$O(^GMR(123,GMRCO,40,GMRCAC,1,I)) Q:'I D
184 . S GMRCMT(NUM)=^GMR(123,GMRCO,40,GMRCAC,1,I,0)
185 . S NUM=NUM+1
186 ;
187 ; file admin correct comment
188 S GMRCDA=$$SETDA^GMRCGUIB ; get new activity ien
189 S GMRCA=26,GMRCAD=$$NOW^XLFDT,DA=GMRCDA
190 D SETCOM^GMRCGUIB(.GMRCMT,DUZ)
191 Q
Note: See TracBrowser for help on using the repository browser.