source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTE7.m@ 1806

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1RARTE7 ;HISC/SM continuation - Delete a Report, Outside Rpt misc;1/31/08 10:44
2 ;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3
3 ;Supported IA #2053 NOW^XLFDT, FILE^DIE, UPDATE^DIE
4 ;Supported IA #2052 GET1^DID
5 ;Supported IA #2055 ROOT^DILFD
6 Q
7MARKDEL ; set field 5 to "X" to mark rpt as deleted
8 ; also update activity log, send report deletion bulletin, store then delete
9 ; associated DX, Staff, Resident data
10 N DA,DIK,RA1,RA2,RAA,RAFDA,RAIEN2,RAIENDX,RAIENL,RACLOAK
11 N RAMEMARR,RAMSG,RAOUT,RAPRTSET,RASAVE,RAX,RA7003
12 ;
13 ;PART 1 - mark report as deleted
14 ;
15 S RASAVE=$P(^RARPT(RAIEN,0),U,5) ;save current rpt status
16 S RAFDA(74,RAIEN_",",5)="X" ;change rpt status
17 D FILE^DIE("","RAFDA")
18 K RAFDA
19 ;
20 ;PART 2 - add new entry to ACTIVITY LOG and store primary data
21 ;
22 S RA7003=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
23 S RAIENL="+1,"_RAIEN_","
24 S RAFDA(74.01,RAIENL,.01)=+$E($$NOW^XLFDT(),1,12)
25 S RAFDA(74.01,RAIENL,2)="X"
26 S RAFDA(74.01,RAIENL,3)=$G(DUZ)
27 S RAFDA(74.01,RAIENL,4)=RASAVE ;store before-delete rpt status
28 S RAFDA(74.01,RAIENL,5)=$P(RA7003,U,13) ; store Prim DX code
29 S RAFDA(74.01,RAIENL,7)=$P(RA7003,U,15) ; store Prim Staff
30 S RAFDA(74.01,RAIENL,9)=$P(RA7003,U,12) ; store Prim Resident
31 D UPDATE^DIE(,"RAFDA","RAOUT","RAMSG")
32 W:$D(RAMSG("DIERR")) !!,"Could not update deleted Report's Activity Log."
33 K RAFDA
34 ;
35 ; store Secondary DXs/Staff/Residents under this ACTIVITY LOG
36 ; if printset, no need to store each case's sec DX, they should be same
37 Q:'RAOUT(1) ;no record set in 74.01
38 S RAIEN2=RAOUT(1)
39 ;
40 ;PART 3 - send report deletion bulletin
41 ;
42 D CLOAK^RABUL3 ; requires RAIEN and RAIEN2
43 ;
44 ;PART 4 - store secondary DX, Staff, Resident data
45 ;
46 ;don't need separate logic for printset for storing identical data
47 F RAFLD=5,7,9 D SET7401(RAFLD)
48 ;
49 ;PART 5 - remove Prim. and Sec. DX, Staff, Resident from case record
50 ;
51 D EN2^RAUTL20(.RAMEMARR) ; is case part of a printset?
52 G:RAPRTSET PSET
53 ;
54 ; single case
55 ;
56 ; delete primaries
57 S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",13)="@" ;Prim. DX
58 S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",15)="@" ;Prim. Staff
59 S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",12)="@" ;Prim. Resident
60 D FILE^DIE("","RAFDA")
61 K RAFDA
62 ;
63 ; delete secondaries
64 F RASUB=70.14,70.11,70.09 D KILSEC(RASUB,RACNI)
65 Q
66 ;
67 ; cases from printset
68 ;
69PSET ;delete primary and secondary data
70 S RA1=0
71 F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
72 .; delete primary from 70.03
73 .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",13)="@" ;Prim. DX
74 .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",15)="@" ;Prim. Staff
75 .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",12)="@" ;Prim. Resident
76 .D FILE^DIE("","RAFDA")
77 .K RAFDA
78 .F RASUB=70.14,70.11,70.09 D KILSEC(RASUB,RA1)
79 Q
80KILSEC(RAF2,RAC1) ;kill secondary data
81 ;RAF2 subfile number from file 70's secondaries
82 ;RAC1 ien for subfile 70.03
83 N RAA,RAROOT
84 K DA,DIK
85 S RAIENS=1_","_RAC1_","_RADTI_","_RADFN_","
86 S RAROOT=$$ROOT^DILFD(RAF2,RAIENS,1) ; closed root
87 M RAA=@RAROOT
88 Q:$O(RAA(0))'>0 ;no secondaries
89 D DA^DILF(RAIENS,.DA) ;get the DA array
90 S DIK=$$ROOT^DILFD(RAF2,RAIENS)
91 S RA2=0
92 F S RA2=$O(RAA(RA2)) Q:'RA2 S DA=RA2 D ^DIK
93 K DIK
94 Q
95SET7401(X) ; use this for DX, Staff, Resident secondaries
96 ; set activity log's subfiles to store any secondaries
97 K RAFDA,RAMSG,RAA
98 ; X is the Field number from subfile 74.01:
99 ; 5 = BEFORE DELETION PRIM. DX CODE
100 ; 7 = BEFORE DELETION PRIM. STAFF
101 ; 9 = BEFORE DELETION PRIM. RESIDENT
102 ;
103 ; RAF1 = subfile number from file 74's activity log
104 ; RAF2 = subfile number from file 70's secondaries
105 ; RAF3 = subfile number pointed to from file 70's secondaries
106 ;
107 S RAF2=$S(X=5:70.14,X=7:70.11,X=9:70.09,1:"") Q:RAF2=""
108 S RAIENS=1_","_RACNI_","_RADTI_","_RADFN_","
109 S RAROOT=$$ROOT^DILFD(RAF2,RAIENS,1) ; closed root, file 70's secondaries
110 M RAA=@RAROOT
111 Q:$O(RAA(0))'>0 ; no secondaries
112 ;
113 S RAF1=$S(X=5:74.16,X=7:74.18,X=9:74.19,1:"") Q:RAF1=""
114 S RAF3=$$GET1^DID(RAF2,.01,"","POINTER")
115 ; extract file number from RAF3
116 S RAF3=$TR(RAF3,$TR(RAF3,"0123456789."))
117 ;
118 ; store Secondary DXs
119 S RA1=0
120 S RAIENDX="+2,"_RAIEN2_","_RAIEN_","
121 F S RA1=$O(RAA(RA1)) Q:'RA1 S RAX=$G(RAA(RA1,0)) D:RAX
122 .S RAFDA(RAF1,RAIENDX,.01)=RAX
123 .D UPDATE^DIE(,"RAFDA",,"RAMSG")
124 .W:$D(RAMSG("DIERR")) !!,"Could not store ",$$GET1^DID(RAF2,.01,"","LABEL"),"'s value: ",$$GET1^DIQ(RAF3,RAX,.01)
125 .K RAFDA,RAMSG
126 .Q
127 Q
128ANYDX(ARRAY) ; called from RARTE5
129 ; input ARRAY name to store all DXs for this case
130 ; output:
131 ; =1 if one or more diag codes
132 ; =0 if no diag code
133 ; ARRAY() stores diag codes as merged from case
134 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
135 K ARRAY
136 M ARRAY=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX") ;Sec Diags
137 S ARRAY(9999,0)=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13) ;Prim Diag
138 I $O(ARRAY(0)) Q 1
139 Q 0
140 ;
141ALERT ; for Outside Report, ck if new/changed diags require alert
142 ; this is called from RARTE5 each time an outside report is edited
143 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
144 ; set RASAVE() for OENOTE^RAUTL00
145 S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
146 ;
147 N I
148 Q:(RANY1=0)&(RANY2=0) ;no diags before and after edit
149 S I=0
150 ; loop RAA2
151 F S I=$O(RAA2(I)) Q:'I K:RAA2(I,0)=$G(RAA1(I,0)) RAA2(I,0)
152 Q:'$O(RAA2(0))
153 S RAAB=0
154 S I=0 F S I=$O(RAA2(I)) Q:'I D
155 .I $D(^RA(78.3,+RAA2(I,0),0)),($P(^(0),U,4)="y") S RAAB=1
156 .Q
157 Q:'RAAB
158 S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
159 S X=RAY3 ; X is input to OENOTE
160 D OENOTE^RAUTL00
161 Q
Note: See TracBrowser for help on using the repository browser.