source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPCE.m@ 613

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

initial load of WorldVistAEHR
File size: 7.9 KB
RevLine 
[613]1RAPCE ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ;9/7/04 12:36pm
2 ;;5.0;Radiology/Nuclear Medicine;**10,17,21,26,41,57,56**;Mar 16, 1998;Build 3
3 ;Supported IA #2053 FILE^DIE
4 ;Supported IA #4663 SWSTAT^IBBAPI
5 ;Controlled IA #1889 DATA2PCE^PXAPI
6 Q
7COMPLETE(RADFN,RADTI,RACNI) ; When an exam status changes to 'complete'
8 ; Input: RADFN-> Patient DFN, RADTI-> Exam Timestamp, RACNI-> Case IEN
9 ; NOTE: RACNI input param is ignored for exam sets (all cases under
10 ; an exam set are processed at once when order is complete)
11 ; $$DATA2PCE^PXAPI returns: 1 if no errors, else error condition
12 ;
13 K ^TMP("DIERR",$J),^TMP("RAPXAPI",$J)
14 N RA7002,RA7003,RA71,RA791,RACNT,RADTE,RAEARRY,RAPKG,RAVSIT,RABAD,RASTAT,RACPTM,RA,RA1,RARECMPL,RACNISAV
15 N RADUPRC,RACOMIEN,RASENT,RALCKFAL
16 S RALCKFAL=0 ; >0 if lock fails when :
17 ; 1= complt'g exam that's unique to other cases same dt/tm, if any
18 ; 2= complt'g exam that's a dupl of another cmplt'd exam (RESEND^RAPCE1)
19 ; 3= UNcompleting exam before deleting credit+visit pointers same dt/tm
20 S RAPKG=$O(^DIC(9.4,"B","RADIOLOGY/NUCLEAR MEDICINE",0))
21 S RADTE=9999999.9999-RADTI,RACNT=0
22 S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
23 S RAXAMSET=+$P(RA7002,"^",5) ; is this part of an exam set? 1=YES
24EN2 S RA791=$G(^RA(79.1,+$P(RA7002,"^",4),0))
25 ; Initialize variables required for PFSS 1B project and check the switch status.
26 N RAPFSW,RACCOUNT S RAPFSW=$$SWSTAT^IBBAPI ; Requirement 12
27 Q:+$P(RA791,"^",21)=2 ; no credit, quit
28 S RAEARRY="RAERROR" N @RAEARRY
29LON ; lock at P level
30 L +^RADPT(RADFN,"DT",RADTI,"P",RACNI):30 I '$T S RALCKFAL=1 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) Q
31 I 'RAXAMSET G NONSET
32 ; exam set, grab all the completed records!
33 S RACNISAV=RACNI
34 S RACNI=0
35 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!($G(RABAD)) D
36 . S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) I $P($G(^RA(72,+$P(RA7003,U,3),0)),U,3)'=9 Q ;check code instead of name
37 . S RACNT=RACNT+1 D SETUP I $G(RABAD) Q
38 . D:'$D(^TMP("RAPXAPI",$J,"ENCOUNTER")) ENC(RACNT)
39 . D DX^RABWPCE($P(RA7003,U,11)) ; Ordering ICD Dx and related data.
40 . D PROC(RACNT)
41 . Q
42 S RACNI=RACNISAV ;restore value so unlock would work 012601
43 I '$G(RABAD),$D(^TMP("RAPXAPI",$J)) D PCE(RADFN,RADTI,RACNI)
44 ;Missing data, send failure bulletin for ea case in set, don't attempt to send data to PCE
45 I $G(RABAD) W:'$D(ZTQUEUED)&('$D(RARECMPL)) !,"Unable to credit Exam set" D
46 . S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ))
47 G KOUT
48NONSET ; non-exam sets
49 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
50 D CKDUP^RAPCE1 ; chk for duplicate procedure(s) non-examset
51 I $G(RADUPRC) D RESEND^RAPCE1 G KOUT ; branch off to re-send rec(s) this dt/tm
52 S RACNT=RACNT+1
53 D SETUP
54 D:'$G(RABAD) ENC(RACNT) D:'$G(RABAD) DX^RABWPCE($P(RA7003,U,11)) D:'$G(RABAD) PROC(RACNT) D:'$G(RABAD) PCE(RADFN,RADTI,RACNI)
55 I $G(RABAD) W:'$D(ZTQUEUED)&('$D(RARECMPL)) !,"Unable to credit exam" D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) ;Missing data, send failure bulletin for single case, don't attempt to pass data to PCE
56 ;
57KOUT K ^TMP("RAPXAPI",$J)
58 L -^RADPT(RADFN,"DT",RADTI,"P",RACNI)
59 Q
60ENC(X) ; Set up the '"RAPXAPI",$J,"ENCOUNTER"' nodes
61 N RAIMGLOC,RA17,RARPTLOC
62 S RA17=+$P(RA7003,U,17)
63 S RARPTLOC=$P($G(^RARPT(RA17,"BA")),U,1)
64 S RAIMGLOC=$P($G(^RA(79.1,+RARPTLOC,0)),"^")
65 S:'RAIMGLOC RAIMGLOC=$P($G(^RA(79.1,+$P(RA7002,"^",4),0)),"^")
66 I RAIMGLOC="" S RABAD=1 Q ; needs imaging location
67 S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"PATIENT")=RADFN
68 S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"ENC D/T")=RADTE
69 S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"HOS LOC")=RAIMGLOC
70 S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"SERVICE CATEGORY")="X"
71 S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"ENCOUNTER TYPE")="A"
72 Q
73PCE(RADFN,RADTI,RACNI) ; Pass on the information to the PCE software
74 N RASULT
75 ; If the PFSS switch is not active then do not pass RACCOUNT parameter to DATA2PCE call.
76 I 'RAPFSW S RASULT=$$DATA2PCE^PXAPI("^TMP(""RAPXAPI"",$J)",RAPKG,"RAD/NUC MED",.RAVSIT,"","","","",.@RAEARRY)
77 ; If the PFSS switch is active then use RACCOUNT parameter in DATA2PCE call.
78 I RAPFSW D
79 . ; PFSS Requirement 6, 11
80 . S RASULT=$$DATA2PCE^PXAPI("^TMP(""RAPXAPI"",$J)",RAPKG,"RAD/NUC MED",.RAVSIT,"","","","",.@RAEARRY,.RACCOUNT)
81 . Q
82 I (RASULT=1)!(RASULT=-1) D ;Visit file pointer, set 'Credit recorded' to yes.
83 . W:'$D(ZTQUEUED)&('$D(RARECMPL)) !?5,"Visit credited.",!
84 . D:'RAXAMSET VISIT(RADFN,RADTI,RACNI,RAVSIT)
85 . D:'RAXAMSET RECDCS(RADFN,RADTI,RACNI) ; only one exam, not a set
86 . D:RAXAMSET MULCS(RADFN,RADTI) ; set, update all exams!
87 . S RASENT=1 ; sent to PCE was okay
88 . Q
89 E D
90 . N RAWHOERR S RAWHOERR=""
91 . W:'$D(ZTQUEUED)&('$D(RARECMPL)) !?5,$C(7),"Unable to credit.",!
92 . I '$G(RAXAMSET) D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ))
93 . I $G(RAXAMSET) D
94 .. S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ))
95 .. Q
96 . Q
97 Q
98MULCS(RADFN,RADTI) ; Update the 'Credit recorded' field and the Visit
99 ;pointer for each case that is complete
100 N RACNI S RACNI=0
101 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D
102 . Q:$P($G(^RA(72,+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3),0)),U,3)'=9
103 . D RECDCS(RADFN,RADTI,RACNI)
104 . D VISIT(RADFN,RADTI,RACNI,RAVSIT)
105 . Q
106 Q
107PROC(X) ; Set up the other '"RAPXAPI",$J,"PROCEDURE"' nodes for this case
108 ; If same procedure repeated in exam set, add to qty of existing
109 ; 'procedure' node. Else, if different provider, create new
110 ; separate 'procedure' nodes
111 N X1,X2,X3,RADUP F X1=1:1:X S X2=$G(^TMP("RAPXAPI",$J,"PROCEDURE",X1,"PROCEDURE")) I X2=$P(RA71,"^",9),^("ENC PROVIDER")=$S(RA7003(15)]"":RA7003(15),1:RA7003(12)) D Q
112 . S ^TMP("RAPXAPI",$J,"PROCEDURE",X1,"QTY")=^("QTY")+1
113 . D CPTMOD(X1)
114 . S RADUP=1
115 . Q
116 I $D(RADUP) Q
117 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"QTY")=1
118 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"PROCEDURE")=$P(RA71,"^",9)
119 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"NARRATIVE")=$P(RA71,"^")
120 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"ENC PROVIDER")=$S(RA7003(15)]"":RA7003(15),1:RA7003(12)) ; Pri. Int Staff if exists, else Pri Int Resident
121 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"ORD PROVIDER")=RA7003(14) ; Requesting Physician.
122 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"EVENT D/T")=RADTE
123 ; if the PFSS switch is active Get both Dept. Code and Account Reference Number (RACCOUNT)
124 I RAPFSW D GETDEPT^RABWIBB ; Requirement 9
125 D CPTMOD(X)
126 D PROCDX^RABWPCE(X) ; Add Ordering ICD Dx to each Procedure.
127 Q
128RECDCS(RADFN,RADTI,RACNI) ; Set 'Clinic Stop Recorded' to yes
129 ; (70.03, fld 23)
130 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",23)="Y"
131 D FILE^DIE("K","RAFDA")
132 Q
133SETUP ; Setup examination data node information
134 ; If no provider, or inactive CPT, fail
135 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
136 S RA7003(12)=$P(RA7003,"^",12) ; Pri. Inter. Resident
137 S RA7003(14)=$P(RA7003,"^",14) ; Requesting Physician.
138 S RA7003(15)=$P(RA7003,"^",15) ; Pri. Inter. Staff
139 ; OK to send if missing resident/staff ONLY if report Elec. Filed
140 I (RA7003(12)="")&(RA7003(15)=""),$P($G(^RARPT(+$P(RA7003,U,17),0)),U,5)'="EF" S RABAD=1 Q
141 S RA71=$G(^RAMIS(71,+$P(RA7003,"^",2),0))
142 ; store CPT Modifiers' .01 value
143 K RACPTM S RA=0 F S RA=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",RA)) Q:'RA S RA1=$$BASICMOD^RACPTMSC($P($G(^(RA,0)),"^"),+$P(RA7002,"^")) S:+RA1>0 RACPTM(RA)=$P(RA1,"^",2) ;only valid cpt mods
144 ; find out if CPT code is active
145 I '$$ACTCODE^RACPTMSC(+$P(RA71,"^",9),$P(RA7002,"^")) S RABAD=1
146 Q
147VISIT(RADFN,RADTI,RACNI,RAVSIT) ; Stuff the Visit file pointer passed back
148 ; from $$DATA2PCE^PXAPI() into the Visit field (70.02, fld 6)
149 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",27)=RAVSIT
150 D FILE^DIE("K","RAFDA")
151 Q
152CPTMOD(X3) ;CPT Modifiers
153 ; CPT Mods for dupl. procedure+provider will be accounted for
154 ; however, same CPT Mod will overwrite previous CPT Mod
155 S ^TMP("RAPXAPI",$J,"PROCEDURE",X3,"MODIFIERS")="" ;prevent abend
156 S RA=0
157 F S RA=$O(RACPTM(RA)) Q:'RA S ^TMP("RAPXAPI",$J,"PROCEDURE",X3,"MODIFIERS",RACPTM(RA))=""
158 Q
Note: See TracBrowser for help on using the repository browser.