- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPCE.m
r613 r623 1 RAPCE ;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 7 COMPLETE(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 24 EN2 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 29 LON ; 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 48 NONSET ; 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 ; 57 KOUT K ^TMP("RAPXAPI",$J) 58 L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 59 Q 60 ENC(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 73 PCE(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 98 MULCS(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 107 PROC(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 128 RECDCS(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 133 SETUP ; 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 147 VISIT(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 152 CPTMOD(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 1 RAPCE ;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 4 COMPLETE(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 21 EN2 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 26 LON ; 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 45 NONSET ; 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 ; 54 KOUT K ^TMP("RAPXAPI",$J) 55 L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 56 Q 57 ENC(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 70 PCE(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 95 MULCS(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 104 PROC(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 125 RECDCS(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 130 SETUP ; 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 143 VISIT(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 148 CPTMOD(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 TracChangeset
for help on using the changeset viewer.
