source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPCE1.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1RAPCE1 ;HIRMFO/GJC-Interface with PCE APIs for workload, visits;6/4/96 15:03 ;5/28/97 12:59
2 ;;5.0;Radiology/Nuclear Medicine;**17,21**;Mar 16, 1998
3 Q
4UNCOMPL(RADFN,RADTI,RACNI) ; When an exam backs out of a complete status
5 ;back out all credit, visit pointers for all rad exams on this d/t
6 ;and re-credit any complete ones that are not part of exam sets.
7 ;
8 ; Input Variables: RADFN=Patient DFN
9 ; RADTI=Inv. date/time of exam
10 ;
11 ; $$DELVFILE^PXAPI returns: 1 if no errors, -4 if transaction OK but
12 ; visit rec still there, else error condition
13 ;
14 N RA7002,RA7003,RARECMPL,RAVSIT,RAXAMSET,RALCKFAL,RAEARRY
15 K ^TMP("RAPXAPI",$J)
16 S RALCKFAL=0 ; need define this due its being used in RAPCE
17 ; RARECMPL (re-complete), if set, is used to suppress displaying msgs
18 S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
19 S RAXAMSET=+$P(RA7002,"^",5)
20 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
21 ;If this case has no visit ptr, whether it is within a set or not,
22 ; quit because crediting never took place (exam set crediting is
23 ; on an "all or nothing" basis)
24 S RAVSIT=$P(RA7003,U,27) I 'RAVSIT Q
25 S RAPKG=+$O(^DIC(9.4,"B","RADIOLOGY/NUCLEAR MEDICINE",0))
26 S RADTE=9999999.9999-RADTI
27 S RA791=$G(^RA(79.1,+$P(RA7002,"^",4),0))
28 S RAEARRY="RAERROR" N @RAEARRY
29 D DELVST
30 K ^TMP("RAPXAPI",$J)
31 Q
32DELVST ; Delete all Rad/Nuc Med pkg data from
33 ; Visit file, other V-files for exam date/time
34 ; lock at DT level due re-crediting all prev cmpltd exms for same dt/tm
35 ; also, lock before deleting entire visit, in case can't delete
36 ; cl.stp.rec and visit pointers from locked record
37 L +^RADPT(RADFN,"DT",RADTI):30 I '$T S RALCKFAL=3 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) W !?5,"Credit cannot be deleted for this exam due to lock failure for this exam date." Q
38 ; quit if lock fails at DT level
39 D DELVPTR(RADFN,RADTI)
40 S RASULT=$$DELVFILE^PXAPI("ALL",RAVSIT,RAPKG,"",0,0,0)
41 I RASULT=1!(RASULT=-4) D
42 . D MULCS(RADFN,RADTI)
43 . W:'$D(ZTQUEUED)&('$D(RADUPRC)) !,"Credit deleted for this Visit."
44 . Q:RAXAMSET
45 .;non-exmsets: re-credit cmplt'd cases of same dt/tm via exmset logic
46 .; set var RAXAMSET to 1 to use code that credits all exms in same dt/tm
47 . S RAXAMSET=1 N RA71,RACNT,RABAD,RACNT,RASTAT S RACNT=0,RARECMPL=1 K RAVSIT D EN2^RAPCE
48 . Q
49 L -^RADPT(RADFN,"DT",RADTI)
50 Q
51DELVPTR(RADFN,RADTI) ; each case in this exmset: del case ptrs to Visit file
52 ; (subfile: 70.03 Field #: 27) ;visit ptr fld
53 N RACNI,RADA1 S RACNI=0
54 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D
55 . S RADA1(70.03,RACNI_","_RADTI_","_RADFN_",",27)="@"
56 . D FILE^DIE("K","RADA1")
57 . K RADA1 ; clear var before reuse, incase filing problem met
58 Q
59MULCS(RADFN,RADTI) ; Clear the 'Clinic Stop Recorded?' field for ea case
60 ; in this exam set
61 ; (subfile: 70.03 Field #: 23) ;credit recorded fld
62 N RACNI,RADA2 S RACNI=0
63 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D
64 . S RADA2(70.03,RACNI_","_RADTI_","_RADFN_",",23)="@"
65 . D FILE^DIE("K","RADA2")
66 . K RADA2 ; clear var before reuse, incase filing problem met
67 . Q
68 Q
69REPNT(RADFN,RADTI) ; Repopulate the visit field
70 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",27)=RAVSIT
71 D FILE^DIE("K","RAFDA")
72 Q
73CKDUP ; are there more than one procedure of same name ?
74 ; return 0 if 1 or fewer completed procedure of the same name/dt/tm
75 ; return 1 if more than 1 completed procedure of the same name/dt/tm
76 ; as this case
77 ; RAX(raprcien) = no. cases with this procedure ien
78 S RADUPRC=0
79 I '$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)),'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI),-1) Q ;only 1 case for this dt/tm
80 N I,J,K,RAX,RAPRCIEN
81 S I=0,RAPRCIEN=+$P(RA7003,U,2)
82C1 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",I)) G:I'=+I C9
83 S J=$P(^(I,0),U,2),K=$P(^(0),U,3) ; J = proc ien, K = status ien
84 G:$P($G(^RA(72,+K,0)),U,3)'=9 C1 ; skip if ordercode is not 9
85 S RACOMIEN(I)="" ; save ien of completed cases for use in RESEND
86 S:J RAX(J)=$G(RAX(J))+1
87 G C1
88C9 Q:$G(RAX(RAPRCIEN))<2
89 S RADUPRC=1 ; more than one completed case has the same procedure for this dt/tm
90 Q
91RESEND ; del and resend this dt/tm
92 ; delete what was previously sent to PCE
93 ; need to lock before finding RAVSIT because another case with same
94 ; patient/procedure/dt/tm may be setting up the visit pointer
95 ; for the first time for this dt/tm, at this moment
96 L +^RADPT(RADFN,"DT",RADTI):30 I '$T S RALCKFAL=2 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) Q ;quit resend if DT-level lock failed
97 N I
98 S I=0 ; find visit pointer from first complted case's non-null visit fld
99D1 S I=$O(RACOMIEN(I)) G:I'=+I D9
100 G:$P(^RADPT(RADFN,"DT",RADTI,"P",I,0),U,27)="" D1
101 S RAVSIT=$P(^(0),U,27)
102D9 I $G(RAVSIT)="" G DUNL ; no valid vst ptr to delete
103 D DELVST
104 W:$G(RASENT)&('$D(ZTQUEUED)) !?5,"Visit credited for duplicate procedure."
105DUNL L -^RADPT(RADFN,"DT",RADTI)
106 Q
Note: See TracBrowser for help on using the repository browser.