source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPCE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

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