Released RA*5*70 SEQ #82 Extracted from mail message **KIDS**:RA*5.0*70^ **INSTALL NAME** RA*5.0*70 "BLD",7101,0) RA*5.0*70^RADIOLOGY/NUCLEAR MEDICINE^0^3081007^y "BLD",7101,1,0) ^^16^16^3060713^ "BLD",7101,1,1,0) The installation of the Project 112/Shipboard Hazard and Defense (SHAD) "BLD",7101,1,2,0) clinical application enhancements will provide sites of the ability to "BLD",7101,1,3,0) collect and store SHAD exposure information related to provided medical "BLD",7101,1,4,0) care, and to share that information with PCE. Further modifications will "BLD",7101,1,5,0) include a change of the Environmental Contaminants (EC) label to be "BLD",7101,1,6,0) Southwest Asia Condition (SWAC). All internal values for "EC" will remain "BLD",7101,1,7,0) and only external values will be modified to SWAC. "BLD",7101,1,8,0) "BLD",7101,1,9,0) Some changes will be noticeable to the user community due to the "BLD",7101,1,10,0) modifications made for this project. New prompts will be displayed and "BLD",7101,1,11,0) screen/report formatting will occur. The new PRIMARY DX RELATED TO "BLD",7101,1,12,0) SHAD field (#100) of the RAD/NUC MED ORDERS file (#75.1) will appear "BLD",7101,1,13,0) on Radiology Reports. No additional processing time should be noticed as "BLD",7101,1,14,0) a result of these modifications. The Southwest Asia Condition label will "BLD",7101,1,15,0) appear on reports and screen prompts in place of the Environmental "BLD",7101,1,16,0) Contaminants label. "BLD",7101,4,0) ^9.64PA^75.1^1 "BLD",7101,4,75.1,0) 75.1 "BLD",7101,4,75.1,2,0) ^9.641^75.1^2 "BLD",7101,4,75.1,2,75.1,0) RAD/NUC MED ORDERS (File-top level) "BLD",7101,4,75.1,2,75.1,1,0) ^9.6411^95^2 "BLD",7101,4,75.1,2,75.1,1,95,0) PRIMARY DX RELATED TO SWA "BLD",7101,4,75.1,2,75.1,1,100,0) PRIMARY DX RELATED TO SHAD "BLD",7101,4,75.1,2,75.13,0) SECONDARY ORDERING ICD DIAG. (sub-file) "BLD",7101,4,75.1,2,75.13,1,0) ^9.6411^5^2 "BLD",7101,4,75.1,2,75.13,1,5,0) SECONDARY DX RELATED TO SWA "BLD",7101,4,75.1,2,75.13,1,9,0) SECONDARY DX RELATED TO SHAD "BLD",7101,4,75.1,222) y^n^p^^^^n^^n "BLD",7101,4,75.1,224) "BLD",7101,4,"APDD",75.1,75.1) "BLD",7101,4,"APDD",75.1,75.1,95) "BLD",7101,4,"APDD",75.1,75.1,100) "BLD",7101,4,"APDD",75.1,75.13) "BLD",7101,4,"APDD",75.1,75.13,5) "BLD",7101,4,"APDD",75.1,75.13,9) "BLD",7101,4,"B",75.1,75.1) "BLD",7101,6) 4^ "BLD",7101,6.3) 7 "BLD",7101,"ABPKG") n "BLD",7101,"KRN",0) ^9.67PA^8989.52^19 "BLD",7101,"KRN",.4,0) .4 "BLD",7101,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",.401,0) .401 "BLD",7101,"KRN",.401,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",.402,0) .402 "BLD",7101,"KRN",.402,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",.403,0) .403 "BLD",7101,"KRN",.5,0) .5 "BLD",7101,"KRN",.5,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",.84,0) .84 "BLD",7101,"KRN",3.6,0) 3.6 "BLD",7101,"KRN",3.6,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",3.8,0) 3.8 "BLD",7101,"KRN",3.8,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",9.2,0) 9.2 "BLD",7101,"KRN",9.8,0) 9.8 "BLD",7101,"KRN",9.8,"NM",0) ^9.68A^262^6 "BLD",7101,"KRN",9.8,"NM",257,0) RABWIBB2^^0^B6563456 "BLD",7101,"KRN",9.8,"NM",258,0) RABWORD^^0^B25103824 "BLD",7101,"KRN",9.8,"NM",259,0) RABWORD1^^0^B20761340 "BLD",7101,"KRN",9.8,"NM",260,0) RABWORD2^^0^B16871765 "BLD",7101,"KRN",9.8,"NM",261,0) RABWPCE^^0^B3018459 "BLD",7101,"KRN",9.8,"NM",262,0) RABWUTL^^0^B1666628 "BLD",7101,"KRN",9.8,"NM","B","RABWIBB2",257) "BLD",7101,"KRN",9.8,"NM","B","RABWORD",258) "BLD",7101,"KRN",9.8,"NM","B","RABWORD1",259) "BLD",7101,"KRN",9.8,"NM","B","RABWORD2",260) "BLD",7101,"KRN",9.8,"NM","B","RABWPCE",261) "BLD",7101,"KRN",9.8,"NM","B","RABWUTL",262) "BLD",7101,"KRN",19,0) 19 "BLD",7101,"KRN",19,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",19.1,0) 19.1 "BLD",7101,"KRN",19.1,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",101,0) 101 "BLD",7101,"KRN",101,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",409.61,0) 409.61 "BLD",7101,"KRN",409.61,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",771,0) 771 "BLD",7101,"KRN",771,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",870,0) 870 "BLD",7101,"KRN",870,"NM",0) ^9.68A^^0 "BLD",7101,"KRN",8989.51,0) 8989.51 "BLD",7101,"KRN",8989.52,0) 8989.52 "BLD",7101,"KRN",8994,0) 8994 "BLD",7101,"KRN","B",.4,.4) "BLD",7101,"KRN","B",.401,.401) "BLD",7101,"KRN","B",.402,.402) "BLD",7101,"KRN","B",.403,.403) "BLD",7101,"KRN","B",.5,.5) "BLD",7101,"KRN","B",.84,.84) "BLD",7101,"KRN","B",3.6,3.6) "BLD",7101,"KRN","B",3.8,3.8) "BLD",7101,"KRN","B",9.2,9.2) "BLD",7101,"KRN","B",9.8,9.8) "BLD",7101,"KRN","B",19,19) "BLD",7101,"KRN","B",19.1,19.1) "BLD",7101,"KRN","B",101,101) "BLD",7101,"KRN","B",409.61,409.61) "BLD",7101,"KRN","B",771,771) "BLD",7101,"KRN","B",870,870) "BLD",7101,"KRN","B",8989.51,8989.51) "BLD",7101,"KRN","B",8989.52,8989.52) "BLD",7101,"KRN","B",8994,8994) "BLD",7101,"QUES",0) ^9.62^^ "BLD",7101,"REQB",0) ^9.611^2^2 "BLD",7101,"REQB",1,0) RA*5.0*57^2 "BLD",7101,"REQB",2,0) SD*5.3*441^2 "BLD",7101,"REQB","B","RA*5.0*57",1) "BLD",7101,"REQB","B","SD*5.3*441",2) "FIA",75.1) RAD/NUC MED ORDERS "FIA",75.1,0) ^RAO(75.1, "FIA",75.1,0,0) 75.1PI "FIA",75.1,0,1) y^n^p^^^^n^^n "FIA",75.1,0,10) "FIA",75.1,0,11) "FIA",75.1,0,"RLRO") "FIA",75.1,0,"VR") 5.0^RA "FIA",75.1,75.1) 1 "FIA",75.1,75.1,95) "FIA",75.1,75.1,100) "FIA",75.1,75.13) 1 "FIA",75.1,75.13,5) "FIA",75.1,75.13,9) "MBREQ") 0 "PKG",115,-1) 1^1 "PKG",115,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",115,20,0) ^9.402P^^ "PKG",115,22,0) ^9.49I^1^1 "PKG",115,22,1,0) 5.0^2980317^2980430^1 "PKG",115,22,1,"PAH",1,0) 70^3081007^123456991 "PKG",115,22,1,"PAH",1,1,0) ^^16^16^3081007 "PKG",115,22,1,"PAH",1,1,1,0) The installation of the Project 112/Shipboard Hazard and Defense (SHAD) "PKG",115,22,1,"PAH",1,1,2,0) clinical application enhancements will provide sites of the ability to "PKG",115,22,1,"PAH",1,1,3,0) collect and store SHAD exposure information related to provided medical "PKG",115,22,1,"PAH",1,1,4,0) care, and to share that information with PCE. Further modifications will "PKG",115,22,1,"PAH",1,1,5,0) include a change of the Environmental Contaminants (EC) label to be "PKG",115,22,1,"PAH",1,1,6,0) Southwest Asia Condition (SWAC). All internal values for "EC" will remain "PKG",115,22,1,"PAH",1,1,7,0) and only external values will be modified to SWAC. "PKG",115,22,1,"PAH",1,1,8,0) "PKG",115,22,1,"PAH",1,1,9,0) Some changes will be noticeable to the user community due to the "PKG",115,22,1,"PAH",1,1,10,0) modifications made for this project. New prompts will be displayed and "PKG",115,22,1,"PAH",1,1,11,0) screen/report formatting will occur. The new PRIMARY DX RELATED TO "PKG",115,22,1,"PAH",1,1,12,0) SHAD field (#100) of the RAD/NUC MED ORDERS file (#75.1) will appear "PKG",115,22,1,"PAH",1,1,13,0) on Radiology Reports. No additional processing time should be noticed as "PKG",115,22,1,"PAH",1,1,14,0) a result of these modifications. The Southwest Asia Condition label will "PKG",115,22,1,"PAH",1,1,15,0) appear on reports and screen prompts in place of the Environmental "PKG",115,22,1,"PAH",1,1,16,0) Contaminants label. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 6 "RTN","RABWIBB2") 0^257^B6563456^B6487618 "RTN","RABWIBB2",1,0) RABWIBB2 ;HOIFO/MDM - Radiology Billing Awareness ;12/20/04 12:55am "RTN","RABWIBB2",2,0) ;;5.0;Radiology/Nuclear Medicine;**57,70**;Mar 16, 1998;Build 7 "RTN","RABWIBB2",3,0) ; $$GETACCT^IBBAPI uses DBIA #4664 "RTN","RABWIBB2",4,0) ; Calls referencing PFSS Account Referance (field 90 file #75.1)) uses DBIA #4741 "RTN","RABWIBB2",5,0) ; "RTN","RABWIBB2",6,0) Q "RTN","RABWIBB2",7,0) GA(RAOIFN) ; Get Account Reference "RTN","RABWIBB2",8,0) ; "RTN","RABWIBB2",9,0) N RAMISDAT,RAPRO,RAITYP,RADAT,RADX,S1,S2,P1,IBBDFN,IBBPV1,IBBPV2 "RTN","RABWIBB2",10,0) N IBBDG1,IBBPR1,IBBZCL,RABADAT,RABAFLD,RAORD0 "RTN","RABWIBB2",11,0) ; Called from FB^RABWIBB "RTN","RABWIBB2",12,0) ; Define remaining (Required) IBB Variables and Arrays "RTN","RABWIBB2",13,0) ; "RTN","RABWIBB2",14,0) ; Radiology Orders Data "RTN","RABWIBB2",15,0) S RAORD0=$G(^RAO(75.1,RAOIFN,0)) "RTN","RABWIBB2",16,0) S IBBDFN=$P(RAORD0,U,1) ; PATIENT NAME Pointer to patient file #2 "RTN","RABWIBB2",17,0) S IBBPV1(2)=$P(RAORD0,U,4) ; PATIENT STATUS I(npatient) O(utpatient) "RTN","RABWIBB2",18,0) S IBBPV1(3)=$P(RAORD0,U,20) "RTN","RABWIBB2",19,0) S IBBPV1(3)=$P($G(^RA(79.1,IBBPV1(3),0)),U,1) ; IMAGING LOCATION "RTN","RABWIBB2",20,0) S IBBPV1(7)=$P(RAORD0,U,14) ; REQUESTING PHYSICIAN "RTN","RABWIBB2",21,0) S IBBPV1(44)=$P(RAORD0,U,21),IBBPV2(8)=IBBPV1(44) ; DATE DESIRED "RTN","RABWIBB2",22,0) S IBBDG1(1,6)="A" ; DIAGNOSIS TYPE "RTN","RABWIBB2",23,0) ; "RTN","RABWIBB2",24,0) ; CPT Code "RTN","RABWIBB2",25,0) S RAPRO=$P(RAORD0,U,2) ; Procedure Pointer "RTN","RABWIBB2",26,0) S RAMISDAT=^RAMIS(71,+RAPRO,0) ; Procedure Data "RTN","RABWIBB2",27,0) S IBBPR1(3)=$P(RAMISDAT,U,9) ; Isolate CPT Code "RTN","RABWIBB2",28,0) ; If there is no CPT Code then get the procedure name instead. "RTN","RABWIBB2",29,0) I IBBPR1(3)="" S IBBPR1(4)=$P(RAMISDAT,U,1) K IBBPR1(3) "RTN","RABWIBB2",30,0) ; "RTN","RABWIBB2",31,0) ; ABBREVIATION FOR TYPE OF IMAGING "RTN","RABWIBB2",32,0) S RAITYP=$P(RAORD0,U,3) ; Image Type File Pointer "RTN","RABWIBB2",33,0) S RADAT=^RA(79.2,+RAITYP,0) ; Image Type File Data "RTN","RABWIBB2",34,0) S IBBPR1(6)=$P(RADAT,U,3) ; Image Type Abbreviation "RTN","RABWIBB2",35,0) ; "RTN","RABWIBB2",36,0) ; CLINICAL INDICATORS RELATED TO PRIMARY DX "RTN","RABWIBB2",37,0) ; Initialize gathering process variables. "RTN","RABWIBB2",38,0) S S1="",RADX(92)=3,RADX(93)=1,RADX(94)=2,RADX(95)=4,RADX(96)=5 "RTN","RABWIBB2",39,0) S RADX(97)=6,RADX(99)=7,RADX(100)=8 "RTN","RABWIBB2",40,0) S RABADAT=$G(^RAO(75.1,+RAOIFN,"BA")) "RTN","RABWIBB2",41,0) S IBBDG1(1,3)=$P(RABADAT,U,1) ; PRIMARY DIAGNOSIS CODE "RTN","RABWIBB2",42,0) S IBBZCL="" "RTN","RABWIBB2",43,0) F P1=92:1:97,99,100 S RABAFLD=$P($P(^DD(75.1,P1,0),U,4),";",2) I $P(RABADAT,U,RABAFLD)]"" D "RTN","RABWIBB2",44,0) . S S1=S1+1 "RTN","RABWIBB2",45,0) . ; IBBZCL(n,2)=clin. Indic. type, IBBZCL(n,3)={0,1,null} "RTN","RABWIBB2",46,0) . S IBBZCL(S1,2)=RADX(P1) "RTN","RABWIBB2",47,0) . S IBBZCL(S1,3)=$P(RABADAT,U,RABAFLD) "RTN","RABWIBB2",48,0) . Q "RTN","RABWIBB2",49,0) ; "RTN","RABWIBB2",50,0) ; Get Account Reference "RTN","RABWIBB2",51,0) S RACCOUNT=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2,.IBBPR1,.IBBDG1,.IBBZCL,"",+RAOIFN) "RTN","RABWIBB2",52,0) Q "RTN","RABWIBB2",53,0) STOR751(RAOIFN) ; Store acct ref no. in file 75.1, field 90, for this order "RTN","RABWIBB2",54,0) ; "RTN","RABWIBB2",55,0) N RAFDA "RTN","RABWIBB2",56,0) S RAFDA(75.1,+RAOIFN_",",90)=RACCOUNT "RTN","RABWIBB2",57,0) D FILE^DIE("K","RAFDA") "RTN","RABWIBB2",58,0) Q "RTN","RABWORD") 0^258^B25103824^B22685982 "RTN","RABWORD",1,0) RABWORD ;HOIFO/JH&MM - Radiology Billing Awareness ;12/20/04 12:55am "RTN","RABWORD",2,0) ;;5.0;Radiology/Nuclear Medicine;**41,57,70**;Mar 16, 1998;Build 7 "RTN","RABWORD",3,0) ; "RTN","RABWORD",4,0) ; Rtn invokes IA #226-C, #1300-A, #2083, #10082, #2343, #4419 "RTN","RABWORD",5,0) Q "RTN","RABWORD",6,0) ; "RTN","RABWORD",7,0) ASK(RADFN,RASDDT) ; Ask ICD DX & SC/EI/MST/HNC questions at time of Order. "RTN","RABWORD",8,0) ; Called from BAQUES^RAORD1 "RTN","RABWORD",9,0) Q:'$D(^XUSEC("PROVIDER",DUZ)) ;user provider key check "RTN","RABWORD",10,0) Q:'$$CIDC^IBBAPI(RADFN) ;patient insurance & CIDC switch check "RTN","RABWORD",11,0) N DIC,I11,RACNT,RADUP,RAQUIT,RABCOPY,RABASEC K RAKILL S RABASEC=0 "RTN","RABWORD",12,0) ;if previous order's ICD9 etc. were copied, then put them in RABWDX to file "RTN","RABWORD",13,0) I $D(^TMP("RACOPY",$J)) D "RTN","RABWORD",14,0) .;remove copied CV value from piece 8 of RABWDX(1) and all RABWDX(RACNT) "RTN","RABWORD",15,0) .I ^TMP("RACOPY",$J,"BA") S RABWDX(1)=^("BA"),$P(RABWDX(1),U,8)="" "RTN","RABWORD",16,0) .S RABCOPY=0,RACNT=1 "RTN","RABWORD",17,0) .F S RABCOPY=$O(^TMP("RACOPY",$J,"BA",RABCOPY)) Q:'RABCOPY S RACNT=RACNT+1,RABWDX(RACNT)=^(RABCOPY),$P(RABWDX(RACNT),U,8)="" "RTN","RABWORD",18,0) PRIMDX I $D(^TMP("RACOPY",$J,"BA")) D "RTN","RABWORD",19,0) .S RABCOPY(1)=^TMP("RACOPY",$J,"BA") "RTN","RABWORD",20,0) .D BADISP^RABWORD1(.RABCOPY) "RTN","RABWORD",21,0) S DIC="^ICD9(",DIC(0)="QEAMNZ" "RTN","RABWORD",22,0) S DIC("A")="Ordering ICD-9 Diagnosis: " "RTN","RABWORD",23,0) S DIC("B")="" I $D(RABWDX(1))&($P($G(RABWDX(1)),U)>0) S DIC("B")=$P(^ICD9(+RABWDX(1),0),U) "RTN","RABWORD",24,0) I $D(RABCOPY) S DIC("B")=$P(RABCOPY(1),U) K RABCOPY "RTN","RABWORD",25,0) S DIC("S")="I $P($$ICDDX^ICDCODE(Y,DT),U,10)" D ^DIC "RTN","RABWORD",26,0) S:(+Y<0) Y=0 "RTN","RABWORD",27,0) S:Y="^" RAQUIT=1 "RTN","RABWORD",28,0) I (+Y>0) D "RTN","RABWORD",29,0) .S RACNT=1,$P(RABWDX(RACNT),U,1)=+Y D BAQUES S Y=1 "RTN","RABWORD",30,0) ; check @ deletion of previous entry "RTN","RABWORD",31,0) I X="@" K RABWDX(1) "RTN","RABWORD",32,0) Q:'$D(RABWDX)!$G(RAQUIT) "RTN","RABWORD",33,0) ; "RTN","RABWORD",34,0) SECDX F I11=1:1:7 Q:($G(RAQUIT)&'$O(RABWDX(I11))) W ! D "RTN","RABWORD",35,0) .I $D(^TMP("RACOPY",$J,"BA"))&(RABASEC'="") D "RTN","RABWORD",36,0) ..S RABASEC=$O(^TMP("RACOPY",$J,"BA",RABASEC)) "RTN","RABWORD",37,0) ..Q:RABASEC="" "RTN","RABWORD",38,0) ..S RABCOPY(2)=^TMP("RACOPY",$J,"BA",RABASEC) "RTN","RABWORD",39,0) ..D BADISP^RABWORD1(.RABCOPY) "RTN","RABWORD",40,0) .S DIC="^ICD9(",DIC(0)="QEAMNZ" "RTN","RABWORD",41,0) .S DIC("A")="Secondary Ordering ICD-9 Diagnosis: " "RTN","RABWORD",42,0) .S DIC("B")="" I $D(RABWDX(I11+1)) S DIC("B")=$P(^ICD9(+RABWDX(I11+1),0),U) "RTN","RABWORD",43,0) .I $D(RABCOPY(2)) S DIC("B")=$P(RABCOPY(2),U) K RABCOPY "RTN","RABWORD",44,0) .S DIC("S")="I $P($$ICDDX^ICDCODE(Y,DT),U,10)" D ^DIC "RTN","RABWORD",45,0) .; delete node RABWDX() if its secondary ICD9 was @-deleted "RTN","RABWORD",46,0) .I X="@" K RABWDX(I11+1) "RTN","RABWORD",47,0) .I +Y<1 S RAQUIT=1 Q ; No More Secondary ICD Dx to Enter. "RTN","RABWORD",48,0) .S RADUP=0 D DUPDX "RTN","RABWORD",49,0) .I RADUP W !?5,"* Cannot Enter Duplicate ICD-9 Diagnosis *" S I11=I11-1 Q "RTN","RABWORD",50,0) .S RACNT=RACNT+1,$P(RABWDX(RACNT),U,1)=+Y D BAQUES "RTN","RABWORD",51,0) K ^TMP("RACOPY",$J) "RTN","RABWORD",52,0) Q ; Quit back to RAORD1 routine. "RTN","RABWORD",53,0) ; "RTN","RABWORD",54,0) BAQUES ; Ask the SC/EI/MST/HNC questions associated to each ICD Dx. "RTN","RABWORD",55,0) N RASEQ,RASEQ1,RASEQ2,RAI0,RASDCLY,RAQUES,RADEFLT,RAEXHELP "RTN","RABWORD",56,0) S RASDCLY="" "RTN","RABWORD",57,0) D CL^SDCO21(RADFN,RASDDT,"",.RASDCLY) "RTN","RABWORD",58,0) ; non-null value in RASDCLY() means that indicator should be asked "RTN","RABWORD",59,0) ; Current Question Sequence is: SC, CV, AO, IR, EC, SHAD, MST, HNC "RTN","RABWORD",60,0) S RASEQ="3,7,1,2,4,8,5,6" ; Same Question Sequence as in $$SEQ^SDCO21 "RTN","RABWORD",61,0) F RAI0=1:1:$L(RASEQ,",") Q:$G(RAQUIT) S RASEQ1=+$P(RASEQ,",",RAI0) I $D(RASDCLY(RASEQ1)) D "RTN","RABWORD",62,0) .S RAQUES="Was treatment related to "_$P($G(^SD(409.41,RASEQ1,0)),U,6) "RTN","RABWORD",63,0) .I RASEQ1=3 S RAQUES="Was treatment for a SC Condition" "RTN","RABWORD",64,0) .S RAEXHELP=$S(RASEQ1=3:"D DIS^DGRPDB",1:"") "RTN","RABWORD",65,0) .S RASEQ2=$S(RASEQ1=3:2,RASEQ1=1:3,RASEQ1=2:4,1:RASEQ1+1) "RTN","RABWORD",66,0) .; if no user entry for CV, default to Yes; else keep user entry for CV "RTN","RABWORD",67,0) .S RADEFLT=$S($P(RABWDX(RACNT),U,RASEQ2)=1:"Yes",$P(RABWDX(RACNT),U,RASEQ2)=0:"NO",RASEQ2=8:"Yes",1:"") "RTN","RABWORD",68,0) .I RADEFLT=""&($D(^TMP("RACOPY",$J))) D "RTN","RABWORD",69,0) ..;find matching DX from Prim and Sec "RACOPY" nodes "RTN","RABWORD",70,0) ..I $P(^TMP("RACOPY",$J,"BA"),U,1)=$P(RABWDX(RACNT),U,1) S RADEFLT=$S($P(^TMP("RACOPY",$J,"BA"),U,RASEQ2)=1:"Yes",$P(^TMP("RACOPY",$J,"BA"),U,RASEQ2)=0:"No",1:"") "RTN","RABWORD",71,0) ..I $D(^TMP("RACOPY",$J,"BA",$P(RABWDX(RACNT),U,1))) S RADEFLT=$S($P(^TMP("RACOPY",$J,"BA",$P(RABWDX(RACNT),U,1)),U,RASEQ2)=1:"Yes",$P(^TMP("RACOPY",$J,"BA",$P(RABWDX(RACNT),U,1)),U,RASEQ2)=0:"No",1:"") "RTN","RABWORD",72,0) .S $P(RABWDX(RACNT),U,RASEQ2)=$S($P(RABWDX(RACNT),U,1)>0:$$ASKYN(RAQUES,RADEFLT,RAEXHELP),1:0) "RTN","RABWORD",73,0) Q "RTN","RABWORD",74,0) ; "RTN","RABWORD",75,0) ASKYN(RAQUES,RADEFLT,RAEXHELP) ; Ask Yes/No Questions "RTN","RABWORD",76,0) N DIR,DIRUT,DUOUT,DTOUT "RTN","RABWORD",77,0) I $G(RAEXHELP)'="" S DIR("??")="^"_RAEXHELP "RTN","RABWORD",78,0) S DIR("A")=" "_RAQUES,DIR(0)="YO" "RTN","RABWORD",79,0) S DIR("B")=RADEFLT D ^DIR "RTN","RABWORD",80,0) S:Y="^" RAQUIT=1 "RTN","RABWORD",81,0) I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) S Y="" ; user typed @ , ^ , or timed out "RTN","RABWORD",82,0) Q Y "RTN","RABWORD",83,0) ; "RTN","RABWORD",84,0) DUPDX ; Check If A Duplicate ICD Dx Has Been Entered. "RTN","RABWORD",85,0) N I "RTN","RABWORD",86,0) F I=1:1 Q:'$D(RABWDX(I)) I (I11+1)'=I,+Y=+RABWDX(I) S RADUP=1 Q "RTN","RABWORD",87,0) Q "RTN","RABWORD",88,0) ; "RTN","RABWORD",89,0) PROV() ; Validate for Provider Key, Active, and non-Terminated statuses. "RTN","RABWORD",90,0) ; Original DIC("S") for Requesting Provider. "RTN","RABWORD",91,0) ; Y = ien file #200 "RTN","RABWORD",92,0) S RACRE=0 ; 1 = person is Active and Credentialed; 0 = otherwise "RTN","RABWORD",93,0) ; Check PROVIDER KEY "RTN","RABWORD",94,0) I $$ACTIVE^XUSER(Y),$D(^XUSEC("PROVIDER",Y)) S RACRE=1 "RTN","RABWORD",95,0) Q RACRE "RTN","RABWORD",96,0) ; "RTN","RABWORD",97,0) FILEDX(RADFN,RAO) ; Store SC/EI Fields in Order file #75.1 "RTN","RABWORD",98,0) ; Called from RAORD1 routine. "RTN","RABWORD",99,0) I '$D(RABWDX) G PFSS "RTN","RABWORD",100,0) N RA1,RA11,RA2,RAFDA,RAIEN,RAMSG "RTN","RABWORD",101,0) S RAFDA(75.1,RAO_",",91)=+RABWDX(1) ; Primary Ordering ICD Dx pointer. "RTN","RABWORD",102,0) F RA1=2:1:9 D "RTN","RABWORD",103,0) .S RA11=$S(RA1<8:RA1,1:RA1+1) ;Skip a field # for CV "RTN","RABWORD",104,0) .S RAFDA(75.1,RAO_",",(90+RA11))=$P(RABWDX(1),U,RA1) "RTN","RABWORD",105,0) D FILE^DIE("K","RAFDA","RAMSG") K RAFDA,RAMSG "RTN","RABWORD",106,0) S RA1=1 "RTN","RABWORD",107,0) F S RA1=$O(RABWDX(RA1)) Q:RA1="" D "RTN","RABWORD",108,0) .S RAFDA(75.13,"?+2,"_RAO_",",.01)=+RABWDX(RA1) "RTN","RABWORD",109,0) .F RA2=2:1:9 D "RTN","RABWORD",110,0) ..S RAFDA(75.13,"?+2,"_RAO_",",RA2)=$P(RABWDX(RA1),U,RA2) "RTN","RABWORD",111,0) .D UPDATE^DIE("","RAFDA","RAIEN","RAMSG") K RAFDA,RAIEN,RAMSG "RTN","RABWORD",112,0) .Q "RTN","RABWORD",113,0) PFSS ; RAO is the IEN of file #75.1 "RTN","RABWORD",114,0) ; we need to make this call before testing for RABWDX because the GETACCT "RTN","RABWORD",115,0) ; must be done regardless of presence of the RABWDX array "RTN","RABWORD",116,0) I '$D(RACPRS) D FB^RABWIBB(RAO) ; Requirement 1 "RTN","RABWORD",117,0) Q "RTN","RABWORD1") 0^259^B20761340^B19945341 "RTN","RABWORD1",1,0) RABWORD1 ;HOIFO/MM-Radiology Billing Awareness ;10/26/04 1:36pm "RTN","RABWORD1",2,0) ;;5.0;Radiology/Nuclear Medicine;**41,57,70**;Mar 16, 1998;Build 7 "RTN","RABWORD1",3,0) ; "RTN","RABWORD1",4,0) ; This routine invokes IA #10082 "RTN","RABWORD1",5,0) Q "RTN","RABWORD1",6,0) ; "RTN","RABWORD1",7,0) BADISP(RABWDX) ; Display ICD DX & SC/EI/MST/HNC answers from the Order. "RTN","RABWORD1",8,0) ; Called from BADISP^RAORDU1 "RTN","RABWORD1",9,0) I '$D(RABWDX) Q "RTN","RABWORD1",10,0) N I1,RACNT,RAIND "RTN","RABWORD1",11,0) ; Create Temp. Array of the Clinical Indicators. "RTN","RABWORD1",12,0) S RAIND(2)="SC",RAIND(3)="AO",RAIND(4)="IR" "RTN","RABWORD1",13,0) S RAIND(5)="SWAC",RAIND(6)="MST",RAIND(7)="HNC",RAIND(8)="CV",RAIND(9)="SHAD" "RTN","RABWORD1",14,0) ; "RTN","RABWORD1",15,0) PRIMDX W:$D(RABWDX(1)) !!,"Primary Ordering ICD-9 Diagnosis: " "RTN","RABWORD1",16,0) N RAICD "RTN","RABWORD1",17,0) I $G(RABWDX(1)) S RAICD=$$ICDDX^ICDCODE($P(RABWDX(1),U),DT,) W $P(RAICD,U,4)," ",$P(RAICD,U,2) "RTN","RABWORD1",18,0) S RACNT=1 D:$D(RABWDX(1)) BARESP "RTN","RABWORD1",19,0) S Y=1 "RTN","RABWORD1",20,0) ; "RTN","RABWORD1",21,0) SECDX S I1=1 "RTN","RABWORD1",22,0) F S I1=$O(RABWDX(I1)) Q:'I1 D "RTN","RABWORD1",23,0) .W !!,"Secondary Ordering ICD-9 Diagnosis: " "RTN","RABWORD1",24,0) .S RAICD=$$ICDDX^ICDCODE($P(RABWDX(I1),U),DT,) "RTN","RABWORD1",25,0) .W $P(RAICD,U,4)," ",$P(RAICD,U,2) "RTN","RABWORD1",26,0) .S RACNT=RACNT+1 D BARESP "RTN","RABWORD1",27,0) Q ; Quit back to calling routine. "RTN","RABWORD1",28,0) ; "RTN","RABWORD1",29,0) BARESP ; Display the SC/EC/EI/MST/HNC responses associated to each ICD Dx. "RTN","RABWORD1",30,0) ; Current Question Sequence is: SC, CV, AO, IR, SWAC, SHAD, MST, HNC "RTN","RABWORD1",31,0) N I0,I2,RA1,RABA S I2=0 "RTN","RABWORD1",32,0) F I0=2:1:9 D "RTN","RABWORD1",33,0) .S RABA=$S(I0=2:2,I0=3:8,I0=9:9,1:I0-1) "RTN","RABWORD1",34,0) .S RA1=$P(RABWDX(RACNT),U,RABA) "RTN","RABWORD1",35,0) .Q:RA1="" "RTN","RABWORD1",36,0) .I I2=0 W !?5 "RTN","RABWORD1",37,0) .S I2=I2+1 I I2>2 S I2=1 W !?5 "RTN","RABWORD1",38,0) .I I2>1 W ?40 "RTN","RABWORD1",39,0) .W RAIND(RABA)," Related? ",$S(RA1=0:"NO",RA1=1:"YES",1:"") "RTN","RABWORD1",40,0) Q "RTN","RABWORD1",41,0) ; "RTN","RABWORD1",42,0) SENDCPRS(RAO) ; Send Billing Aware Ordering ICD Dx data to CPRS. "RTN","RABWORD1",43,0) ; Called from EN1+n^RAO7NEW. "RTN","RABWORD1",44,0) ; RABWDX1 variable comes from RAO7NEW routine. "RTN","RABWORD1",45,0) Q:'$$PATCH^XPDUTL("OR*3.0*190") ;check for required BA-OR patch "RTN","RABWORD1",46,0) N I,II,RA1,RA2,RA2A,RACNT,RACNT1,RAICD1,RAICD3 "RTN","RABWORD1",47,0) I '$D(^RAO(75.1,RAO,0)) Q "RTN","RABWORD1",48,0) S RA1=$G(^RAO(75.1,RAO,"BA")) I +RA1<1 Q "RTN","RABWORD1",49,0) S (RACNT,RACNT1)=0 "RTN","RABWORD1",50,0) S RA2=^RAO(75.1,RAO,"BA") D SEND1 "RTN","RABWORD1",51,0) S RA1=0 "RTN","RABWORD1",52,0) F S RA1=$O(^RAO(75.1,RAO,"BAS",RA1)) Q:+RA1<1 S RA2=^(RA1,0) D SEND1 "RTN","RABWORD1",53,0) Q "RTN","RABWORD1",54,0) ; "RTN","RABWORD1",55,0) SEND1 S RAICD1=$P(^ICD9(+RA2,0),U,1),RAICD3=$P(^ICD9(+RA2,0),U,3) "RTN","RABWORD1",56,0) S RACNT=RACNT+1 "RTN","RABWORD1",57,0) S RABWDX1(RACNT)="DG1"_RAHLFS_RACNT_RAHLFS_RAHLFS_+RA2_RAECH(1)_RAICD3_RAECH(1)_"80"_RAECH(1)_RAICD1_RAECH(1)_RAICD3_RAECH(1)_"ICD9" "RTN","RABWORD1",58,0) S RACNT1=RACNT "RTN","RABWORD1",59,0) F I=2:1:9 D "RTN","RABWORD1",60,0) .S II=$S(I=2:3,I=3:4,I=4:2,1:I),RA2A=$P(RA2,U,II) "RTN","RABWORD1",61,0) .S RACNT1=RACNT1+.1 "RTN","RABWORD1",62,0) .S RABWDX1(RACNT1)="ZCL"_RAHLFS_RACNT_RAHLFS_(I-1)_RAHLFS_RA2A "RTN","RABWORD1",63,0) Q "RTN","RABWORD1",64,0) ; "RTN","RABWORD1",65,0) GETCPRS ; Retrieve and Store Ordering ICD Dx data from CPRS DG1 & ZCL Segments. "RTN","RABWORD1",66,0) ; Called from EN1+n^RAO7RON. "RTN","RABWORD1",67,0) I '$D(RADATA) Q "RTN","RABWORD1",68,0) N I,RA1 "RTN","RABWORD1",69,0) I RAHDR="DG1" D ; Ordering ICD Dx. "RTN","RABWORD1",70,0) .I +RADATA=1 S RANEW(75.1,"+1,",91)=+$P(RADATA,RAHLFS,3) "RTN","RABWORD1",71,0) .E S RANEW(75.13,"+1"_(+RADATA)_",+1,",.01)=+$P(RADATA,RAHLFS,3) "RTN","RABWORD1",72,0) I RAHDR="ZCL" D ; Ordering ICD Dx related SC/EI/MST/HNC. "RTN","RABWORD1",73,0) .F I=2,3 S RA1(I)=$P(RADATA,RAHLFS,I) "RTN","RABWORD1",74,0) .S RA1(2)=$S(RA1(2)=3:1,RA1(2)=1:2,RA1(2)=2:3,1:RA1(2)) "RTN","RABWORD1",75,0) .; adjust for CV and SHAD since fld no. 98 is skipped, SWM20070702 "RTN","RABWORD1",76,0) .I +RADATA=1 S:RA1(2)>6 RA1(2)=RA1(2)+1 S RANEW(75.1,"+1,",(91+RA1(2)))=RA1(3) "RTN","RABWORD1",77,0) .E S RANEW(75.13,"+1"_(+RADATA)_",+1,",(1+RA1(2)))=RA1(3) "RTN","RABWORD1",78,0) Q "RTN","RABWORD1",79,0) CPRSUPD(RADFN,RAITEM,RAORIEN,RADX,RASCEI) ;Update Order DXs edited during SignOff in CPRS "RTN","RABWORD1",80,0) ; PFSS 1B Requirement 1 "RTN","RABWORD1",81,0) ; Radiology backdoor orders normally cannot be changed from CPRS GUI. "RTN","RABWORD1",82,0) ; The exceptions are TELEPHONE and VERBAL orders which were entered "RTN","RABWORD1",83,0) ; from "backdoor" Vista Radiology, and changed later in CPRS GUI. However, "RTN","RABWORD1",84,0) ; only the Diagnoses and Clinical Indicators for the order can be changed. "RTN","RABWORD1",85,0) ; The change from the CPRS GUI can occur before or after the exam has been "RTN","RABWORD1",86,0) ; completed. "RTN","RABWORD1",87,0) ; "RTN","RABWORD1",88,0) ; For PFSS, we do NOT want to get another account number when the back door "RTN","RABWORD1",89,0) ; order has been edited. Thus we need to flag that we're processing a CPRS "RTN","RABWORD1",90,0) ; update before calling FILEDX^RABWORD from this routine. "RTN","RABWORD1",91,0) ; "RTN","RABWORD1",92,0) N RAMSG,RADXIN,RADTI,RACNI,RAUPD,RASCEII S RAMSG=1,(RADXIN,RAUPD)=0,(RADTI,RACNI)="" "RTN","RABWORD1",93,0) N RACPRS S RACPRS=1 ; flag CPRS update "RTN","RABWORD1",94,0) I $P($G(^RAO(75.1,+RAITEM,0)),U,7)'=+RAORIEN D "RTN","RABWORD1",95,0) .S RAMSG="0^Order #"_RAORIEN_" does not match Radiology Order #"_RAITEM "RTN","RABWORD1",96,0) I RAMSG&($P($G(^RAO(75.1,+RAITEM,0)),U)'=RADFN) D "RTN","RABWORD1",97,0) .S RAMSG="0^Order #"_RAORIEN_"'s DFN="_RADFN_", but Radiology Order #"_RAITEM_"'s DFN="_$P(^RAO(75.1,+RAITEM,0),U) "RTN","RABWORD1",98,0) I RAMSG D "RTN","RABWORD1",99,0) .K DIK,DA S DA(1)=RAITEM,DA=0,DIK="^RAO(75.1,"_DA(1)_",""BAS""," ;Delete old DXs "RTN","RABWORD1",100,0) .F S DA=$O(^RAO(75.1,RAITEM,"BAS",DA)) Q:DA="" D "RTN","RABWORD1",101,0) ..D ^DIK "RTN","RABWORD1",102,0) .K DIK,DA "RTN","RABWORD1",103,0) .;Build the DX array and file "RTN","RABWORD1",104,0) .S RASCEII=RASCEI,$P(RASCEII,U,2)=$P(RASCEI,U),$P(RASCEII,U,3)=$P(RASCEI,U,2),$P(RASCEII,U)=$P(RASCEI,U,3) "RTN","RABWORD1",105,0) .F S RADXIN=$O(RADX(RADXIN)) Q:RADXIN="" D "RTN","RABWORD1",106,0) ..S RABWDX(RADXIN)=RADX(RADXIN)_"^"_RASCEII "RTN","RABWORD1",107,0) .I $D(RABWDX) D "RTN","RABWORD1",108,0) ..S:$P($G(^RAO(75.1,RAITEM,0)),U,5)=2 RAUPD=1 "RTN","RABWORD1",109,0) ..D FILEDX^RABWORD(RADFN,RAITEM) "RTN","RABWORD1",110,0) ..I RAUPD D "RTN","RABWORD1",111,0) ...S RADTI=$O(^RADPT("AO",RAITEM,RADFN,RADTI)) Q:'RADTI "RTN","RABWORD1",112,0) ...S RACNI=$O(^RADPT("AO",RAITEM,RADFN,RADTI,RACNI)) Q:'RACNI "RTN","RABWORD1",113,0) ...S ZTQUEUED=1 "RTN","RABWORD1",114,0) ...D UNCOMPL^RAPCE1(RADFN,RADTI,RACNI) "RTN","RABWORD1",115,0) ...D:$P($G(^RADPT(RADFN,"DT",0)),U,5) COMPLETE^RAPCE(RADFN,RADTI,RACNI) "RTN","RABWORD1",116,0) K RADFN,RAITEM,RAORIEN,RASCEI,RABWDX,RADX "RTN","RABWORD1",117,0) Q RAMSG "RTN","RABWORD1",118,0) ;Explanation of vars, fields, pieces, etc. by Clin. Ind., SWM20070702 "RTN","RABWORD1",119,0) ; CL INT File File Sub- Sub- RASEQ1 RASEQ2 "RTN","RABWORD1",120,0) ; ^SDCO21 from 75.1 75.1 file file from its'the "RTN","RABWORD1",121,0) ; ZCL "BA" Field 75.13 75.13 BAQUES piece "RTN","RABWORD1",122,0) ; |rec node No. "BAS" Field ^RABWORD no. in "RTN","RABWORD1",123,0) ; |int Prim. node No. RABWDX "RTN","RABWORD1",124,0) ; |value DXs Sec. (racnt) "RTN","RABWORD1",125,0) ; DXs "RTN","RABWORD1",126,0) ;AO 1 1 ;3 93 ;3 3 1 3 "RTN","RABWORD1",127,0) ;IR 2 2 ;4 94 ;4 4 2 4 "RTN","RABWORD1",128,0) ;SC 3 3 ;2 92 ;2 2 3 2 "RTN","RABWORD1",129,0) ;SWAC 4 4 ;5 95 ;5 5 4 5 "RTN","RABWORD1",130,0) ;MST 5 5 ;6 96 ;6 6 5 6 "RTN","RABWORD1",131,0) ;HNC 6 6 ;7 97 ;7 7 6 7 "RTN","RABWORD1",132,0) ;CV 7 7 ;8 99 ;8 8 7 8 "RTN","RABWORD1",133,0) ;SHAD 8 8 ;9 100 ;9 9 8 9 "RTN","RABWORD1",134,0) ; "RTN","RABWORD1",135,0) ;Sample format of ZCL segments from CPRS GUI base on "RTN","RABWORD1",136,0) ;Clinical indicators associated with Ordering Diagnoses: "RTN","RABWORD1",137,0) ; "RTN","RABWORD1",138,0) ;Primary Ordering Diag. First Secondary Diag. Next Secondary Diag. "RTN","RABWORD1",139,0) ;ZCL|1|1|0 <-- AO ZCL|2|1| ZCL|3|1| "RTN","RABWORD1",140,0) ;ZCL|1|2|1 IR ZCL|2|2|1 ZCL|3|2| "RTN","RABWORD1",141,0) ;ZCL|1|3|1 SC ZCL|2|3|1 ZCL|3|3|1 "RTN","RABWORD1",142,0) ;ZCL|1|4|0 SWAC ZCL|2|4| ZCL|3|4| "RTN","RABWORD1",143,0) ;ZCL|1|5|0 MST ZCL|2|5| ZCL|3|5| "RTN","RABWORD1",144,0) ;ZCL|1|6| HNC ZCL|2|6| ZCL|3|6| "RTN","RABWORD1",145,0) ;ZCL|1|7|1 CV ZCL|2|7| ZCL|3|7| "RTN","RABWORD1",146,0) ;ZCL|1|8| SHAD ZCL|3|8| ZCL|3|8| "RTN","RABWORD2") 0^260^B16871765^B16425324 "RTN","RABWORD2",1,0) RABWORD2 ;HOIFO/KAR - Radiology Billing Awareness ;12/20/04 3:55pm "RTN","RABWORD2",2,0) ;;5.0;Radiology/Nuclear Medicine;**41,70**;Mar 16, 1998;Build 7 "RTN","RABWORD2",3,0) ; "RTN","RABWORD2",4,0) ; Rtn invokes IA #1300-A, #2083, #4419 "RTN","RABWORD2",5,0) Q "RTN","RABWORD2",6,0) ORDER ; List Exam Orders to select to copy ICD-9 SC/EC Indicator values from "RTN","RABWORD2",7,0) D HDR S (RAXIT,RACOPY)=0 "RTN","RABWORD2",8,0) N RALP,RA751,DIROUT,DIRUT,DTOUT,DUOUT S (RALP,RAXIT)=0 "RTN","RABWORD2",9,0) F S RALP=$O(^RAO(75.1,"B",RADFN,RALP)) Q:RALP'>0!(RAXIT) D "RTN","RABWORD2",10,0) .S RA751(0)=$G(^RAO(75.1,RALP,0)),RA751(2)=$P(RA751(0),U,2) "RTN","RABWORD2",11,0) .Q:RA751(2)="" "RTN","RABWORD2",12,0) .S RA751(16)=$P(RA751(0),U,16),RA751(20)=$P(RA751(0),U,20) "RTN","RABWORD2",13,0) .S RA751(5)=+$P(RA751(0),U,5) Q:RA751(5)=1 "RTN","RABWORD2",14,0) .S Y=RA751(2),C=$P($G(^DD(75.1,2,0)),U,2) D Y^DIQ S RA751(2)=Y "RTN","RABWORD2",15,0) .S Y=RA751(20),C=$P($G(^DD(75.1,20,0)),U,2) D Y^DIQ S RA751(20)=Y "RTN","RABWORD2",16,0) .S RACOPY=RACOPY+1,RACOPY(RACOPY)=RALP "RTN","RABWORD2",17,0) .W !,RACOPY,?10,$E(RA751(2),1,28),?39 "RTN","RABWORD2",18,0) .W $S(RA751(16)]"":$$FMTE^XLFDT(RA751(16),"2D"),1:"") "RTN","RABWORD2",19,0) .W ?52,$E(RA751(20),1,12) ; prints 'SUBMIT REQUEST TO' data "RTN","RABWORD2",20,0) .I $E(IOST,1,2)="C-",($Y>(IOSL-4)) D "RTN","RABWORD2",21,0) ..K DIR S DIR(0)="E" D ^DIR K DIR S:'+Y RAXIT=1 "RTN","RABWORD2",22,0) ..I 'RAXIT W @IOF D HDR "RTN","RABWORD2",23,0) Q "RTN","RABWORD2",24,0) HDR ; Header "RTN","RABWORD2",25,0) D HOME^%ZIS W:$D(RAOPT("ORDEREXAM"))#2 @IOF "RTN","RABWORD2",26,0) W !!,"#",?10,"Last Procedures/New Orders",?39,"Order Date",?52,"Imaging Loc." "RTN","RABWORD2",27,0) W !,"------",?10,"----------------------------",?39,"------------",?52,"------------" "RTN","RABWORD2",28,0) Q "RTN","RABWORD2",29,0) PREV ;Prompt for Copying a previous Order's DX/SC/EC values. "RTN","RABWORD2",30,0) Q:'$D(^XUSEC("PROVIDER",DUZ)) ;user provider key check "RTN","RABWORD2",31,0) Q:'$$CIDC^IBBAPI(RADFN) ;patient insurance & CIDC switch check "RTN","RABWORD2",32,0) N RAPREV S RAPREV=0 K DIR "RTN","RABWORD2",33,0) I $P($G(VAEL(3)),"^") D "RTN","RABWORD2",34,0) .S DIR("B")="NO",DIR("A")="Copy a previous order's ICD codes and SC/EI values",DIR(0)="YO" "RTN","RABWORD2",35,0) .S DIR("?")="Answer 'Y' if you plan to copy ICD-9 Diagnosis codes and Service Connected/Environmental Indicator values to this order." D ^DIR "RTN","RABWORD2",36,0) I '$P($G(VAEL(3)),"^") D "RTN","RABWORD2",37,0) .S DIR("B")="NO",DIR("A")="Copy a previous order's ICD codes",DIR(0)="YO" "RTN","RABWORD2",38,0) .S DIR("?")="Answer 'Y' if you plan to copy ICD-9 Diagnosis codes to this order." D ^DIR "RTN","RABWORD2",39,0) I Y D "RTN","RABWORD2",40,0) .N RACOPY D ORDER "RTN","RABWORD2",41,0) .K DIR S DIR("A")="Select Order # to copy",DIR(0)="NO" D ^DIR "RTN","RABWORD2",42,0) .I '$D(RACOPY(+Y)) W !,"*Invalid selection" S RAPREV=1 Q "RTN","RABWORD2",43,0) .I +Y>0 D "RTN","RABWORD2",44,0) ..I '$D(^RAO(75.1,RACOPY(+Y),"BA")) W !,"*No Previous ICD codes entered for this order" Q "RTN","RABWORD2",45,0) ..S ^TMP("RACOPY",$J,"BA")=^RAO(75.1,RACOPY(+Y),"BA") "RTN","RABWORD2",46,0) ..N RABASEC S RABASEC=0 F S RABASEC=$O(^RAO(75.1,RACOPY(+Y),"BAS",RABASEC)) Q:RABASEC<1 D "RTN","RABWORD2",47,0) ...S ^TMP("RACOPY",$J,"BA",$P(^RAO(75.1,RACOPY(+Y),"BAS",RABASEC,0),U,1))=^RAO(75.1,RACOPY(+Y),"BAS",RABASEC,0) "RTN","RABWORD2",48,0) G:RAPREV PREV "RTN","RABWORD2",49,0) Q "RTN","RABWORD2",50,0) ELIG ;List the Service Connected ratios for the patient "RTN","RABWORD2",51,0) N RAY,RAELIG,RASC,RAPERC,RAAO,RAIR,RAEC,RASHAD "RTN","RABWORD2",52,0) D DEM^VADPT,ELIG^VADPT,SVC^VADPT "RTN","RABWORD2",53,0) S RAELIG=$P(VAEL(1),"^",2),RASC=$P(VAEL(3),"^"),RASC=$S(RASC:"YES",RASC=0:"NO",1:""),RAPERC=$P(VAEL(3),"^",2) "RTN","RABWORD2",54,0) S RAAO=$S(VASV(2):"YES",1:"NO"),RAIR=$S(VASV(3):"YES",1:"NO"),RASHAD=$S($G(VASV(11)):"YES",1:"NO") "RTN","RABWORD2",55,0) S DIC=2,DA=RADFN,DR=".322013",DIQ="RAY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR "RTN","RABWORD2",56,0) S RAEC=RAY(2,RADFN,.322013,"I"),RAEC=$S(RAEC="Y":"YES",1:"NO") "RTN","RABWORD2",57,0) W @IOF,!,VADM(1)_" ("_VA("PID")_") ",$P(VAEL(6),"^",2),!!," * * * Eligibility Information and Service Connected Conditions * * *" "RTN","RABWORD2",58,0) W !!,?5,"Primary Eligibility: "_RAELIG,!,?5,"A/O Exp.: "_RAAO,?22,"ION Rad.: "_RAIR,?40,"SWAC: "_RAEC,?57,"SHAD: "_RASHAD,! "RTN","RABWORD2",59,0) Q "RTN","RABWORD2",60,0) ADDEXAM ;Add DX/SC/EI data to new order when adding order to Last Visit "RTN","RABWORD2",61,0) Q:'$D(^XUSEC("PROVIDER",DUZ)) ;user provider key check "RTN","RABWORD2",62,0) Q:'$$CIDC^IBBAPI(RADFN) ;patient insurance & CIDC switch check "RTN","RABWORD2",63,0) N RAOIEN,RACOPY,RABASEC "RTN","RABWORD2",64,0) S RAOIEN=$P(^RADPT(RADFN,"DT",RAVLEDTI,"P",RAVLECNI,0),U,11) "RTN","RABWORD2",65,0) Q:'$D(^RAO(75.1,RAOIEN,"BA")) "RTN","RABWORD2",66,0) S ^TMP("RACOPY",$J,"BA")=^RAO(75.1,RAOIEN,"BA") "RTN","RABWORD2",67,0) S RABASEC=0 F S RABASEC=$O(^RAO(75.1,RAOIEN,"BAS",RABASEC)) Q:RABASEC<1 D "RTN","RABWORD2",68,0) .S ^TMP("RACOPY",$J,"BA",$P(^RAO(75.1,RAOIEN,"BAS",RABASEC,0),U,1))=^RAO(75.1,RAOIEN,"BAS",RABASEC,0) "RTN","RABWORD2",69,0) Q "RTN","RABWPCE") 0^261^B3018459^B2776659 "RTN","RABWPCE",1,0) RABWPCE ;HISC/MM - Billing Awareness Project: PCE API ; 3/23/04 10:17am "RTN","RABWPCE",2,0) ;;5.0;Radiology/Nuclear Medicine;**41,70**; Mar 16, 1998;Build 7 "RTN","RABWPCE",3,0) Q "RTN","RABWPCE",4,0) ; "RTN","RABWPCE",5,0) DX(RAO) ; Create ^TMP("RAPXAPI",$J,"DX/PL" for PCE API: Ordering ICD Dx. "RTN","RABWPCE",6,0) ; Called from LON+n^RAPCE. "RTN","RABWPCE",7,0) ; ^RAO(75.1,RAO,"BAx",0) = ICD Diagnosis^SC^AO^IR^EC^SHAD^MST^HNC "RTN","RABWPCE",8,0) ; NOTE: "EC" now represents "SWAC" but this internal value is not being changed. only "RTN","RABWPCE",9,0) ; external display text is being modified. This instance of "EC" is passed to PCE and "RTN","RABWPCE",10,0) ; PCE will handle converting it to any external value on their end. "RTN","RABWPCE",11,0) ; Set an Order" node for Billing Replacement "RTN","RABWPCE",12,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",1,"ORD REFERENCE")=$P(^RAO(75.1,RAO,0),U,7) "RTN","RABWPCE",13,0) I '$D(^RAO(75.1,RAO,"BA")) Q "RTN","RABWPCE",14,0) N RA1,RA2,RA3,RACNT,RADXTYP,RAIND "RTN","RABWPCE",15,0) ; "RTN","RABWPCE",16,0) ; Create Temp. Array of the Clinical Indicators. "RTN","RABWPCE",17,0) S RAIND(1)="SC",RAIND(2)="AO",RAIND(3)="IR" "RTN","RABWPCE",18,0) S RAIND(4)="EC",RAIND(5)="MST",RAIND(6)="HNC",RAIND(7)="CV",RAIND(8)="SHAD" "RTN","RABWPCE",19,0) ; "RTN","RABWPCE",20,0) S RACNT=0 "RTN","RABWPCE",21,0) S RA2=^RAO(75.1,RAO,"BA") D DXPL ; Primary Ordering ICD Dx. "RTN","RABWPCE",22,0) S RA1=0 "RTN","RABWPCE",23,0) F S RA1=$O(^RAO(75.1,RAO,"BAS",RA1)) Q:+RA1<1 S RA2=^(RA1,0) D DXPL "RTN","RABWPCE",24,0) Q "RTN","RABWPCE",25,0) ; "RTN","RABWPCE",26,0) DXPL ; Create "DX/PL" Node. "RTN","RABWPCE",27,0) S RACNT=RACNT+1 "RTN","RABWPCE",28,0) S RADXTYP=$S(RACNT=1:"P",1:"S") "RTN","RABWPCE",29,0) S ^TMP("RAPXAPI",$J,"DX/PL",RACNT,"DIAGNOSIS")=$P(RA2,U) "RTN","RABWPCE",30,0) S ^TMP("RAPXAPI",$J,"DX/PL",RACNT,"PRIMARY")=RADXTYP "RTN","RABWPCE",31,0) ;F RA3=2:1:8 I $P(RA2,U,RA3)'="" D "RTN","RABWPCE",32,0) F RA3=2:1:9 D "RTN","RABWPCE",33,0) .S ^TMP("RAPXAPI",$J,"DX/PL",RACNT,"PL "_RAIND(RA3-1))=$P(RA2,U,RA3) "RTN","RABWPCE",34,0) Q "RTN","RABWPCE",35,0) ; "RTN","RABWPCE",36,0) PROCDX(X) ; Called from PROC^RAPCE. "RTN","RABWPCE",37,0) ; Add Ordering ICD Dx to Procedure for Billing Purposes. "RTN","RABWPCE",38,0) N I "RTN","RABWPCE",39,0) F I=1:1:9 Q:'$D(^TMP("RAPXAPI",$J,"DX/PL",I,"DIAGNOSIS")) D "RTN","RABWPCE",40,0) .I I=1 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"DIAGNOSIS")=^("DIAGNOSIS") Q "RTN","RABWPCE",41,0) .S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"DIAGNOSIS "_I)=^("DIAGNOSIS") "RTN","RABWPCE",42,0) Q "RTN","RABWUTL") 0^262^B1666628^B1548732 "RTN","RABWUTL",1,0) RABWUTL ;HISC/SM - Billing Aware utilities ;3/24/04 "RTN","RABWUTL",2,0) ;;5.0;Radiology/Nuclear Medicine;**41,70**;Mar 16,1998;Build 7 "RTN","RABWUTL",3,0) Q "RTN","RABWUTL",4,0) ODX(RA) ;ordering diagnosis "RTN","RABWUTL",5,0) ;RA = ien file 75.1 "RTN","RABWUTL",6,0) ;RAX(n) = ien80^SC^AO^IR^SWAC^MST^SHAD^HNC^CV where pieces 2+ has 1=Y "RTN","RABWUTL",7,0) ;N RAX,RA1,I,J,RABA,RA751,X "RTN","RABWUTL",8,0) S RA751=$S($D(RAORD0):RAORD0,1:^RAO(75.1,RA,0)) "RTN","RABWUTL",9,0) D GETDX "RTN","RABWUTL",10,0) D WRTDX "RTN","RABWUTL",11,0) Q "RTN","RABWUTL",12,0) GETDX ; get DX and Clin. Indicators from file 75.1 "RTN","RABWUTL",13,0) Q:'$D(^RAO(75.1,RA,"BA")) S RAX(1)=^("BA") "RTN","RABWUTL",14,0) S I=0,RA1=1 "RTN","RABWUTL",15,0) F S I=$O(^RAO(75.1,RA,"BAS",I)) Q:'I D "RTN","RABWUTL",16,0) . S RA1=RA1+1 "RTN","RABWUTL",17,0) . S RAX(RA1)=^RAO(75.1,RA,"BAS",I,0) "RTN","RABWUTL",18,0) .Q "RTN","RABWUTL",19,0) Q "RTN","RABWUTL",20,0) WRTDX ; write DX and Clin. Inds. "RTN","RABWUTL",21,0) Q:'$O(RAX(0)) "RTN","RABWUTL",22,0) W !,"Ordering Diagnoses:" "RTN","RABWUTL",23,0) S I=0 "RTN","RABWUTL",24,0) F S I=$O(RAX(I)) Q:'I D "RTN","RABWUTL",25,0) . W !?2,$$GET1^DIQ(80,+RAX(I),.01),?10,$$GET1^DIQ(80,+RAX(I),3) "RTN","RABWUTL",26,0) . S X=$P(RAX(I),U,2,9) "RTN","RABWUTL",27,0) . Q:X'["1" "RTN","RABWUTL",28,0) . W !,?10,"Clinical Indicator(s): " "RTN","RABWUTL",29,0) . F J=1:1:8 I $P(X,U,J) W $S(J=1:"SC",J=2:"AO",J=3:"IR",J=4:"SWAC",J=5:"MST",J=6:"HNC",J=7:"CV",1:"SHAD") W:$P(X,U,J+1,8)["1" "," "RTN","RABWUTL",30,0) . Q "RTN","RABWUTL",31,0) Q "UP",75.1,75.13,-1) 75.1^BAS "UP",75.1,75.13,0) 75.13 "VER") 8.0^22.0 "^DD",75.1,75.1,95,0) PRIMARY DX RELATED TO SWAC^S^0:NO;1:YES;^BA;5^Q "^DD",75.1,75.1,95,3) If this order is for treating a Southwest Asia Conditions related problem, enter "YES" here. "^DD",75.1,75.1,95,21,0) ^.001^2^2^3081007^^ "^DD",75.1,75.1,95,21,1,0) This field is used to indicate if this order was for treating "^DD",75.1,75.1,95,21,2,0) a VA patient based on a Southwest Asia Conditions related problem. "^DD",75.1,75.1,95,"DT") 3060627 "^DD",75.1,75.1,100,0) PRIMARY DX RELATED TO SHAD^S^0:NO;1:YES;^BA;9^Q "^DD",75.1,75.1,100,3) If this order is for treating a Shipboard Hazard and Defense related problem, enter 'YES' here. "^DD",75.1,75.1,100,21,0) ^.001^2^2^3081007^^ "^DD",75.1,75.1,100,21,1,0) This field is used to indicate if this order was for treating a VA "^DD",75.1,75.1,100,21,2,0) patient based on a Shipboard Hazard and Defense related problem. "^DD",75.1,75.1,100,"DT") 3060314 "^DD",75.1,75.13,5,0) SECONDARY DX RELATED TO SWAC^S^0:NO;1:YES;^0;5^Q "^DD",75.1,75.13,5,3) If this order is for treating a Southwest Asia Conditions related problem, enter "YES" here. "^DD",75.1,75.13,5,21,0) ^.001^2^2^3081007^^ "^DD",75.1,75.13,5,21,1,0) This field is used to indicate if this order was for treating "^DD",75.1,75.13,5,21,2,0) a VA patient based on a Southwest Asia Conditions related problem. "^DD",75.1,75.13,5,"DT") 3060627 "^DD",75.1,75.13,9,0) SECONDARY DX RELATED TO SHAD^S^0:NO;1:YES;^0;9^Q "^DD",75.1,75.13,9,3) If this order is for treating a Shipboard Hazard and Defense related problem, enter 'YES' here. "^DD",75.1,75.13,9,21,0) ^.001^2^2^3081007^^ "^DD",75.1,75.13,9,21,1,0) This field is used to indicate if this order was for treating a "^DD",75.1,75.13,9,21,2,0) Shipboard Hazard and Defense related problem. "^DD",75.1,75.13,9,"DT") 3060314 "BLD",7101,6) ^82 **END** **END**