Released RA*5*57 SEQ #56 Extracted from mail message **KIDS**:RA*5.0*57^ **INSTALL NAME** RA*5.0*57 "BLD",5987,0) RA*5.0*57^RADIOLOGY/NUCLEAR MEDICINE^0^3060202^y "BLD",5987,1,0) ^^1^1^3050803^ "BLD",5987,1,1,0) Please see patch description on FORUM "BLD",5987,4,0) ^9.64PA^79.2^2 "BLD",5987,4,75.1,0) 75.1 "BLD",5987,4,75.1,2,0) ^9.641^75.1^1 "BLD",5987,4,75.1,2,75.1,0) RAD/NUC MED ORDERS (File-top level) "BLD",5987,4,75.1,2,75.1,1,0) ^9.6411^90^1 "BLD",5987,4,75.1,2,75.1,1,90,0) PFSS ACCOUNT REFERENCE "BLD",5987,4,75.1,222) y^n^p^^^^n^^n "BLD",5987,4,75.1,224) "BLD",5987,4,79.2,0) 79.2 "BLD",5987,4,79.2,2,0) ^9.641^79.2^1 "BLD",5987,4,79.2,2,79.2,0) IMAGING TYPE (File-top level) "BLD",5987,4,79.2,2,79.2,1,0) ^9.6411^90^1 "BLD",5987,4,79.2,2,79.2,1,90,0) PFSS Dept. Code "BLD",5987,4,79.2,222) y^n^p^^^^n^^n "BLD",5987,4,79.2,224) "BLD",5987,4,"APDD",75.1,75.1) "BLD",5987,4,"APDD",75.1,75.1,90) "BLD",5987,4,"APDD",79.2,79.2) "BLD",5987,4,"APDD",79.2,79.2,90) "BLD",5987,4,"B",75.1,75.1) "BLD",5987,4,"B",79.2,79.2) "BLD",5987,6) 4^ "BLD",5987,"ABNS",0) ^9.66A^1^1 "BLD",5987,"ABNS",1,0) RA "BLD",5987,"ABNS",1,1,0) ^9.661A^^ "BLD",5987,"ABNS","B","RA",1) "BLD",5987,"ABPKG") n^n "BLD",5987,"INID") ^n "BLD",5987,"INIT") RA57PST "BLD",5987,"KRN",0) ^9.67PA^8989.52^19 "BLD",5987,"KRN",.4,0) .4 "BLD",5987,"KRN",.4,"NM",0) ^9.68A^^ "BLD",5987,"KRN",.401,0) .401 "BLD",5987,"KRN",.402,0) .402 "BLD",5987,"KRN",.403,0) .403 "BLD",5987,"KRN",.5,0) .5 "BLD",5987,"KRN",.84,0) .84 "BLD",5987,"KRN",3.6,0) 3.6 "BLD",5987,"KRN",3.8,0) 3.8 "BLD",5987,"KRN",9.2,0) 9.2 "BLD",5987,"KRN",9.8,0) 9.8 "BLD",5987,"KRN",9.8,"NM",0) ^9.68A^9^9 "BLD",5987,"KRN",9.8,"NM",1,0) RABWORD^^0^B22685982 "BLD",5987,"KRN",9.8,"NM",2,0) RABWORD1^^0^B19945341 "BLD",5987,"KRN",9.8,"NM",3,0) RAO7OKS^^0^B3815375 "BLD",5987,"KRN",9.8,"NM",4,0) RAO7UTL^^0^B26579249 "BLD",5987,"KRN",9.8,"NM",5,0) RAORDU^^0^B27668360 "BLD",5987,"KRN",9.8,"NM",6,0) RAPCE^^0^B45053281 "BLD",5987,"KRN",9.8,"NM",7,0) RA57PST^^0^B4380126 "BLD",5987,"KRN",9.8,"NM",8,0) RABWIBB^^0^B3220184 "BLD",5987,"KRN",9.8,"NM",9,0) RABWIBB2^^0^B6487618 "BLD",5987,"KRN",9.8,"NM","B","RA57PST",7) "BLD",5987,"KRN",9.8,"NM","B","RABWIBB",8) "BLD",5987,"KRN",9.8,"NM","B","RABWIBB2",9) "BLD",5987,"KRN",9.8,"NM","B","RABWORD",1) "BLD",5987,"KRN",9.8,"NM","B","RABWORD1",2) "BLD",5987,"KRN",9.8,"NM","B","RAO7OKS",3) "BLD",5987,"KRN",9.8,"NM","B","RAO7UTL",4) "BLD",5987,"KRN",9.8,"NM","B","RAORDU",5) "BLD",5987,"KRN",9.8,"NM","B","RAPCE",6) "BLD",5987,"KRN",19,0) 19 "BLD",5987,"KRN",19.1,0) 19.1 "BLD",5987,"KRN",101,0) 101 "BLD",5987,"KRN",409.61,0) 409.61 "BLD",5987,"KRN",771,0) 771 "BLD",5987,"KRN",870,0) 870 "BLD",5987,"KRN",8989.51,0) 8989.51 "BLD",5987,"KRN",8989.52,0) 8989.52 "BLD",5987,"KRN",8994,0) 8994 "BLD",5987,"KRN","B",.4,.4) "BLD",5987,"KRN","B",.401,.401) "BLD",5987,"KRN","B",.402,.402) "BLD",5987,"KRN","B",.403,.403) "BLD",5987,"KRN","B",.5,.5) "BLD",5987,"KRN","B",.84,.84) "BLD",5987,"KRN","B",3.6,3.6) "BLD",5987,"KRN","B",3.8,3.8) "BLD",5987,"KRN","B",9.2,9.2) "BLD",5987,"KRN","B",9.8,9.8) "BLD",5987,"KRN","B",19,19) "BLD",5987,"KRN","B",19.1,19.1) "BLD",5987,"KRN","B",101,101) "BLD",5987,"KRN","B",409.61,409.61) "BLD",5987,"KRN","B",771,771) "BLD",5987,"KRN","B",870,870) "BLD",5987,"KRN","B",8989.51,8989.51) "BLD",5987,"KRN","B",8989.52,8989.52) "BLD",5987,"KRN","B",8994,8994) "BLD",5987,"QUES",0) ^9.62^^ "BLD",5987,"REQB",0) ^9.611^5^3 "BLD",5987,"REQB",2,0) RA*5.0*41^2 "BLD",5987,"REQB",4,0) IB*2.0*286^2 "BLD",5987,"REQB",5,0) RA*5.0*45^2 "BLD",5987,"REQB","B","IB*2.0*286",4) "BLD",5987,"REQB","B","RA*5.0*41",2) "BLD",5987,"REQB","B","RA*5.0*45",5) "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,90) "FIA",79.2) IMAGING TYPE "FIA",79.2,0) ^RA(79.2, "FIA",79.2,0,0) 79.2 "FIA",79.2,0,1) y^n^p^^^^n^^n "FIA",79.2,0,10) "FIA",79.2,0,11) "FIA",79.2,0,"RLRO") "FIA",79.2,0,"VR") 5.0^RA "FIA",79.2,79.2) 1 "FIA",79.2,79.2,90) "INIT") RA57PST "MBREQ") 0 "PKG",31,-1) 1^1 "PKG",31,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",31,22,0) ^9.49I^1^1 "PKG",31,22,1,0) 5.0^2980317^2981117^66481 "PKG",31,22,1,"PAH",1,0) 57^3060202^1000000000000000003 "PKG",31,22,1,"PAH",1,1,0) ^^1^1^3060202 "PKG",31,22,1,"PAH",1,1,1,0) Please see patch description on FORUM "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") 9 "RTN","RA57PST") 0^7^B4380126 "RTN","RA57PST",1,0) RA57PST ;HIOFO/SWM-Post install ;12/20/04 12:55am "RTN","RA57PST",2,0) ;;5.0;Radiology/Nuclear Medicine;**57**;Mar 16, 1998 "RTN","RA57PST",3,0) ; This is the post-install routine for patch RA*5.0*57 "RTN","RA57PST",4,0) ; It will loop thru file 79.2 and insert appropriate Dept Code "RTN","RA57PST",5,0) ; "RTN","RA57PST",6,0) ; This routine may be deleted after RA*5.0*57 is installed. "RTN","RA57PST",7,0) ; "RTN","RA57PST",8,0) ; Variable initialization. "RTN","RA57PST",9,0) N RA1,RA2,RAFDA,RATXT,RAVAL,RAX "RTN","RA57PST",10,0) S RATXT(1)="" "RTN","RA57PST",11,0) S RATXT(2)="** File 79.2 IMAGING TYPE has been updated with Dept. Code for the PFSS project. **" "RTN","RA57PST",12,0) S RA1=0 "RTN","RA57PST",13,0) ; Traverse the IMAGING TYPE FILE "RTN","RA57PST",14,0) F S RA1=$O(^RA(79.2,RA1)) Q:'RA1 I $D(^(RA1,0)) D "RTN","RA57PST",15,0) . ; Gather the data from the zero node and extract the first 3 characters of the .01 (NAME) field. "RTN","RA57PST",16,0) . S RA2=^RA(79.2,RA1,0),RAX=$E(RA2,1,3) "RTN","RA57PST",17,0) . ; Inspect the extracted characters and assign a code number associated with that string. "RTN","RA57PST",18,0) . S RAVAL=$S(RAX="GEN":"105",RAX="NUC":"109",RAX="ULT":"115",RAX="MAG":"151",RAX="CT ":"150",RAX="ANG":"152",RAX="CAR":"109",RAX="VAS":"421",RAX="MAM":"703",1:"") "RTN","RA57PST",19,0) . S RAFDA(79.2,RA1_",",90)=RAVAL ; Dept Code is in field #90. "RTN","RA57PST",20,0) . D FILE^DIE("K","RAFDA") ; Use filemans function to populate the field. "RTN","RA57PST",21,0) . ; If there is an error returned set up special error text. "RTN","RA57PST",22,0) . I $D(RAMSG) S RATXT(2)="** Error in updating file 79.2 IMAGING TYPE with Dept. Code for the PFSS project. **" "RTN","RA57PST",23,0) . ; End of task loop "RTN","RA57PST",24,0) . Q "RTN","RA57PST",25,0) ; Display any message returned from the filing activity. "RTN","RA57PST",26,0) D MES^XPDUTL(.RATXT) "RTN","RA57PST",27,0) Q "RTN","RABWIBB") 0^8^B3220184 "RTN","RABWIBB",1,0) RABWIBB ;HOIFO/MDM - Radiology Billing Awareness ;12/20/04 12:55am "RTN","RABWIBB",2,0) ;;5.0;Radiology/Nuclear Medicine;**57**;Mar 16, 1998 "RTN","RABWIBB",3,0) ; $$SWSTAT^IBBAPI uses DBIA #4663 "RTN","RABWIBB",4,0) ; "RTN","RABWIBB",5,0) Q "RTN","RABWIBB",6,0) FB(RAOIFN) ; called by ACC^RAO7OKS and FILEDX^RABWORD "RTN","RABWIBB",7,0) ; Functional Requirement 12 "RTN","RABWIBB",8,0) ; Check PFSS Master Switch and quit if it is not on. "RTN","RABWIBB",9,0) I '$$SWSTAT^IBBAPI() Q "RTN","RABWIBB",10,0) ; "RTN","RABWIBB",11,0) ; Initialize relevent variables "RTN","RABWIBB",12,0) ; IBBARFN = Account Reference Number "RTN","RABWIBB",13,0) ; IBBEVENT = HL7 Event Code "RTN","RABWIBB",14,0) S IBBARFN="",IBBEVENT="A05" "RTN","RABWIBB",15,0) ; Calling routine "RTN","RABWIBB",16,0) S IBBAPLR="FB^RABWIBB" "RTN","RABWIBB",17,0) ; "RTN","RABWIBB",18,0) ; Define remaining (Required) IBB Variables and Arrays "RTN","RABWIBB",19,0) D GA^RABWIBB2(RAOIFN) "RTN","RABWIBB",20,0) ; "RTN","RABWIBB",21,0) ; Functional Requirement 5 "RTN","RABWIBB",22,0) D STOR751^RABWIBB2(RAOIFN) "RTN","RABWIBB",23,0) Q "RTN","RABWIBB",24,0) PV1 ; (called by RAO7UTL) Front Door "RTN","RABWIBB",25,0) ; OR EVSEND -> RA RECEIVE -> RAO7RO -> RAO7UTL "RTN","RABWIBB",26,0) ; "RTN","RABWIBB",27,0) I '$$SWSTAT^IBBAPI() Q ; PFSS is not turned on so stop "RTN","RABWIBB",28,0) I $G(RACCOUNT)="" Q ; Needed data is missing so stop "RTN","RABWIBB",29,0) ; "RTN","RABWIBB",30,0) ; set RAPF to include PV1.50 "RTN","RABWIBB",31,0) ; $$STR(n) returns n delimiters. "RTN","RABWIBB",32,0) S RAPF="PV1"_$$STR^RAO7UTL(2)_RA("PV1",2)_RAHLFS_RA("PV1",3)_$$STR^RAO7UTL(47)_RACCOUNT "RTN","RABWIBB",33,0) ; "RTN","RABWIBB",34,0) Q "RTN","RABWIBB",35,0) DC(RAOIFN) ; called by EXMCAN^RAORDC "RTN","RABWIBB",36,0) ; "RTN","RABWIBB",37,0) I '$$SWSTAT^IBBAPI() Q ; PFSS is not turned on so stop "RTN","RABWIBB",38,0) S RACCOUNT=$P(^RAO(75.1,RAOIFN,0),U,28) ; Get Account Reference "RTN","RABWIBB",39,0) S IBBARFN=RACCOUNT "RTN","RABWIBB",40,0) S IBBEVENT="A38" "RTN","RABWIBB",41,0) ; Calling routine "RTN","RABWIBB",42,0) S IBBAPLR="DC^RABWIBB" "RTN","RABWIBB",43,0) D GA^RABWIBB2(RAOIFN) "RTN","RABWIBB",44,0) ; "RTN","RABWIBB",45,0) Q "RTN","RABWIBB",46,0) GETDEPT ; called by PROC^RAPCE "RTN","RABWIBB",47,0) S RAOIMG=$P($G(^RAO(75.1,RAOIFN,0)),U,3),RACCOUNT=$P($G(^RAO(75.1,RAOIFN,0)),U,28) "RTN","RABWIBB",48,0) S RAIDPT=$P($G(^RA(79.2,RAOIMG,0)),U,6) "RTN","RABWIBB",49,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"DEPARTMENT")=RAIDPT ; Requirement 11 "RTN","RABWIBB",50,0) Q "RTN","RABWIBB2") 0^9^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**;Mar 16, 1998 "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 "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 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^1^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**;Mar 16, 1998 "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) .I ^TMP("RACOPY",$J,"BA") S RABWDX(1)=^("BA") "RTN","RABWORD",15,0) .S RABCOPY=0,RACNT=1 "RTN","RABWORD",16,0) .F S RABCOPY=$O(^TMP("RACOPY",$J,"BA",RABCOPY)) Q:'RABCOPY S RACNT=RACNT+1,RABWDX(RACNT)=^(RABCOPY) "RTN","RABWORD",17,0) PRIMDX I $D(^TMP("RACOPY",$J,"BA")) D "RTN","RABWORD",18,0) .S RABCOPY(1)=^TMP("RACOPY",$J,"BA") "RTN","RABWORD",19,0) .D BADISP^RABWORD1(.RABCOPY) "RTN","RABWORD",20,0) S DIC="^ICD9(",DIC(0)="QEAMNZ" "RTN","RABWORD",21,0) S DIC("A")="Ordering ICD-9 Diagnosis: " "RTN","RABWORD",22,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",23,0) I $D(RABCOPY) S DIC("B")=$P(RABCOPY(1),U) K RABCOPY "RTN","RABWORD",24,0) S DIC("S")="I $P($$ICDDX^ICDCODE(Y,DT),U,10)" D ^DIC "RTN","RABWORD",25,0) S:(+Y<0) Y=0 "RTN","RABWORD",26,0) S:Y="^" RAQUIT=1 "RTN","RABWORD",27,0) I (+Y>0) D "RTN","RABWORD",28,0) .S RACNT=1,$P(RABWDX(RACNT),U,1)=+Y D BAQUES S Y=1 "RTN","RABWORD",29,0) ; check @ deletion of previous entry "RTN","RABWORD",30,0) I X="@" K RABWDX(1) "RTN","RABWORD",31,0) Q:'$D(RABWDX)!$G(RAQUIT) "RTN","RABWORD",32,0) ; "RTN","RABWORD",33,0) SECDX F I11=1:1:7 Q:($G(RAQUIT)&'$O(RABWDX(I11))) W ! D "RTN","RABWORD",34,0) .I $D(^TMP("RACOPY",$J,"BA"))&(RABASEC'="") D "RTN","RABWORD",35,0) ..S RABASEC=$O(^TMP("RACOPY",$J,"BA",RABASEC)) "RTN","RABWORD",36,0) ..Q:RABASEC="" "RTN","RABWORD",37,0) ..S RABCOPY(2)=^TMP("RACOPY",$J,"BA",RABASEC) "RTN","RABWORD",38,0) ..D BADISP^RABWORD1(.RABCOPY) "RTN","RABWORD",39,0) .S DIC="^ICD9(",DIC(0)="QEAMNZ" "RTN","RABWORD",40,0) .S DIC("A")="Secondary Ordering ICD-9 Diagnosis: " "RTN","RABWORD",41,0) .S DIC("B")="" I $D(RABWDX(I11+1)) S DIC("B")=$P(^ICD9(+RABWDX(I11+1),0),U) "RTN","RABWORD",42,0) .I $D(RABCOPY(2)) S DIC("B")=$P(RABCOPY(2),U) K RABCOPY "RTN","RABWORD",43,0) .S DIC("S")="I $P($$ICDDX^ICDCODE(Y,DT),U,10)" D ^DIC "RTN","RABWORD",44,0) .; delete node RABWDX() if its secondary ICD9 was @-deleted "RTN","RABWORD",45,0) .I X="@" K RABWDX(I11+1) "RTN","RABWORD",46,0) .I +Y<1 S RAQUIT=1 Q ; No More Secondary ICD Dx to Enter. "RTN","RABWORD",47,0) .S RADUP=0 D DUPDX "RTN","RABWORD",48,0) .I RADUP W !?5,"* Cannot Enter Duplicate ICD-9 Diagnosis *" S I11=I11-1 Q "RTN","RABWORD",49,0) .S RACNT=RACNT+1,$P(RABWDX(RACNT),U,1)=+Y D BAQUES "RTN","RABWORD",50,0) K ^TMP("RACOPY",$J) "RTN","RABWORD",51,0) Q ; Quit back to RAORD1 routine. "RTN","RABWORD",52,0) ; "RTN","RABWORD",53,0) BAQUES ; Ask the SC/EI/MST/HNC questions associated to each ICD Dx. "RTN","RABWORD",54,0) N RASEQ,RASEQ1,RASEQ2,RAI0,RASDCLY,RAQUES,RADEFLT,RAEXHELP "RTN","RABWORD",55,0) S RASDCLY="" "RTN","RABWORD",56,0) D CL^SDCO21(RADFN,RASDDT,"",.RASDCLY) "RTN","RABWORD",57,0) ; Current Question Sequence is: SC, CV, AO, IR, EC, MST, HNC "RTN","RABWORD",58,0) S RASEQ="3,7,1,2,4,5,6" ; Same Question Sequence as in $$SEQ^SDCO21 "RTN","RABWORD",59,0) F RAI0=1:1:$L(RASEQ,",") Q:$G(RAQUIT) S RASEQ1=+$P(RASEQ,",",RAI0) I $D(RASDCLY(RASEQ1)) D "RTN","RABWORD",60,0) .S RAQUES="Was treatment related to "_$P($G(^SD(409.41,RASEQ1,0)),U,6) "RTN","RABWORD",61,0) .I RASEQ1=3 S RAQUES="Was treatment for a SC Condition" "RTN","RABWORD",62,0) .S RAEXHELP=$S(RASEQ1=3:"D DIS^DGRPDB",1:"") "RTN","RABWORD",63,0) .S RASEQ2=$S(RASEQ1=3:2,RASEQ1=1:3,RASEQ1=2:4,1:RASEQ1+1) "RTN","RABWORD",64,0) .S RADEFLT=$S($P(RABWDX(RACNT),U,RASEQ2)=1:"Yes",$P(RABWDX(RACNT),U,RASEQ2)=0:"NO",1:"") "RTN","RABWORD",65,0) .I RADEFLT=""&($D(^TMP("RACOPY",$J))) D "RTN","RABWORD",66,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",67,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",68,0) .S $P(RABWDX(RACNT),U,RASEQ2)=$S($P(RABWDX(RACNT),U,1)>0:$$ASKYN(RAQUES,RADEFLT,RAEXHELP),1:0) "RTN","RABWORD",69,0) Q "RTN","RABWORD",70,0) ; "RTN","RABWORD",71,0) ASKYN(RAQUES,RADEFLT,RAEXHELP) ; Ask Yes/No Questions "RTN","RABWORD",72,0) N DIR,DIRUT,DUOUT,DTOUT "RTN","RABWORD",73,0) I $G(RAEXHELP)'="" S DIR("??")="^"_RAEXHELP "RTN","RABWORD",74,0) S DIR("A")=" "_RAQUES,DIR(0)="YO" "RTN","RABWORD",75,0) S DIR("B")=RADEFLT D ^DIR "RTN","RABWORD",76,0) S:Y="^" RAQUIT=1 "RTN","RABWORD",77,0) I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) S Y="" ; user typed @ , ^ , or timed out "RTN","RABWORD",78,0) Q Y "RTN","RABWORD",79,0) ; "RTN","RABWORD",80,0) DUPDX ; Check If A Duplicate ICD Dx Has Been Entered. "RTN","RABWORD",81,0) N I "RTN","RABWORD",82,0) F I=1:1 Q:'$D(RABWDX(I)) I (I11+1)'=I,+Y=+RABWDX(I) S RADUP=1 Q "RTN","RABWORD",83,0) Q "RTN","RABWORD",84,0) ; "RTN","RABWORD",85,0) PROV() ; Validate for Provider Key, Active, and non-Terminated statuses. "RTN","RABWORD",86,0) ; Original DIC("S") for Requesting Provider. "RTN","RABWORD",87,0) ; Y = ien file #200 "RTN","RABWORD",88,0) S RACRE=0 ; 1 = person is Active and Credentialed; 0 = otherwise "RTN","RABWORD",89,0) ; Check PROVIDER KEY "RTN","RABWORD",90,0) I $$ACTIVE^XUSER(Y),$D(^XUSEC("PROVIDER",Y)) S RACRE=1 "RTN","RABWORD",91,0) Q RACRE "RTN","RABWORD",92,0) ; "RTN","RABWORD",93,0) FILEDX(RADFN,RAO) ; Store SC/EI Fields in Order file #75.1 "RTN","RABWORD",94,0) ; Called from RAORD1 routine. "RTN","RABWORD",95,0) I '$D(RABWDX) G PFSS "RTN","RABWORD",96,0) N RA1,RA11,RA2,RAFDA,RAIEN,RAMSG "RTN","RABWORD",97,0) S RAFDA(75.1,RAO_",",91)=+RABWDX(1) ; Primary Ordering ICD Dx pointer. "RTN","RABWORD",98,0) F RA1=2:1:8 D "RTN","RABWORD",99,0) .S RA11=$S(RA1=8:9,1:RA1) ;Skip a field # for CV "RTN","RABWORD",100,0) .S RAFDA(75.1,RAO_",",(90+RA11))=$P(RABWDX(1),U,RA1) "RTN","RABWORD",101,0) D FILE^DIE("K","RAFDA","RAMSG") K RAFDA,RAMSG "RTN","RABWORD",102,0) S RA1=1 "RTN","RABWORD",103,0) F S RA1=$O(RABWDX(RA1)) Q:RA1="" D "RTN","RABWORD",104,0) .S RAFDA(75.13,"?+2,"_RAO_",",.01)=+RABWDX(RA1) "RTN","RABWORD",105,0) .F RA2=2:1:8 D "RTN","RABWORD",106,0) ..S RAFDA(75.13,"?+2,"_RAO_",",RA2)=$P(RABWDX(RA1),U,RA2) "RTN","RABWORD",107,0) .D UPDATE^DIE("","RAFDA","RAIEN","RAMSG") K RAFDA,RAIEN,RAMSG "RTN","RABWORD",108,0) .Q "RTN","RABWORD",109,0) PFSS ; RAO is the IEN of file #75.1 "RTN","RABWORD",110,0) ; we need to make this call before testing for RABWDX because the GETACCT "RTN","RABWORD",111,0) ; must be done regardless of presence of the RABWDX array "RTN","RABWORD",112,0) I '$D(RACPRS) D FB^RABWIBB(RAO) ; Requirement 1 "RTN","RABWORD",113,0) Q "RTN","RABWORD1") 0^2^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**;Mar 16, 1998 "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)="EC",RAIND(6)="MST",RAIND(7)="HNC",RAIND(8)="CV" "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, EC, MST, HNC "RTN","RABWORD1",31,0) N I0,I2,RA1,RABA S I2=0 "RTN","RABWORD1",32,0) F I0=2:1:8 D "RTN","RABWORD1",33,0) .S RABA=$S(I0=2:2,I0=3:8,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:8 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) .I +RADATA=1 S:RA1(2)=7 RA1(2)=8 S RANEW(75.1,"+1,",(91+RA1(2)))=RA1(3) "RTN","RABWORD1",76,0) .E S RANEW(75.13,"+1"_(+RADATA)_",+1,",(1+RA1(2)))=RA1(3) "RTN","RABWORD1",77,0) Q "RTN","RABWORD1",78,0) CPRSUPD(RADFN,RAITEM,RAORIEN,RADX,RASCEI) ;Update Order DXs edited during SignOff in CPRS "RTN","RABWORD1",79,0) ; PFSS 1B Requirement 1 "RTN","RABWORD1",80,0) ; Radiology backdoor orders normally cannot be changed from CPRS GUI. "RTN","RABWORD1",81,0) ; The exceptions are TELEPHONE and VERBAL orders which were entered "RTN","RABWORD1",82,0) ; from "backdoor" Vista Radiology, and changed later in CPRS GUI. However, "RTN","RABWORD1",83,0) ; only the Diagnoses and Clinical Indicators for the order can be changed. "RTN","RABWORD1",84,0) ; The change from the CPRS GUI can occur before or after the exam has been "RTN","RABWORD1",85,0) ; completed. "RTN","RABWORD1",86,0) ; "RTN","RABWORD1",87,0) ; For PFSS, we do NOT want to get another account number when the back door "RTN","RABWORD1",88,0) ; order has been edited. Thus we need to flag that we're processing a CPRS "RTN","RABWORD1",89,0) ; update before calling FILEDX^RABWORD from this routine. "RTN","RABWORD1",90,0) ; "RTN","RABWORD1",91,0) N RAMSG,RADXIN,RADTI,RACNI,RAUPD,RASCEII S RAMSG=1,(RADXIN,RAUPD)=0,(RADTI,RACNI)="" "RTN","RABWORD1",92,0) N RACPRS S RACPRS=1 ; flag CPRS update "RTN","RABWORD1",93,0) I $P($G(^RAO(75.1,+RAITEM,0)),U,7)'=+RAORIEN D "RTN","RABWORD1",94,0) .S RAMSG="0^Order #"_RAORIEN_" does not match Radiology Order #"_RAITEM "RTN","RABWORD1",95,0) I RAMSG&($P($G(^RAO(75.1,+RAITEM,0)),U)'=RADFN) D "RTN","RABWORD1",96,0) .S RAMSG="0^Order #"_RAORIEN_"'s DFN="_RADFN_", but Radiology Order #"_RAITEM_"'s DFN="_$P(^RAO(75.1,+RAITEM,0),U) "RTN","RABWORD1",97,0) I RAMSG D "RTN","RABWORD1",98,0) .K DIK,DA S DA(1)=RAITEM,DA=0,DIK="^RAO(75.1,"_DA(1)_",""BAS""," ;Delete old DXs "RTN","RABWORD1",99,0) .F S DA=$O(^RAO(75.1,RAITEM,"BAS",DA)) Q:DA="" D "RTN","RABWORD1",100,0) ..D ^DIK "RTN","RABWORD1",101,0) .K DIK,DA "RTN","RABWORD1",102,0) .;Build the DX array and file "RTN","RABWORD1",103,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",104,0) .F S RADXIN=$O(RADX(RADXIN)) Q:RADXIN="" D "RTN","RABWORD1",105,0) ..S RABWDX(RADXIN)=RADX(RADXIN)_"^"_RASCEII "RTN","RABWORD1",106,0) .I $D(RABWDX) D "RTN","RABWORD1",107,0) ..S:$P($G(^RAO(75.1,RAITEM,0)),U,5)=2 RAUPD=1 "RTN","RABWORD1",108,0) ..D FILEDX^RABWORD(RADFN,RAITEM) "RTN","RABWORD1",109,0) ..I RAUPD D "RTN","RABWORD1",110,0) ...S RADTI=$O(^RADPT("AO",RAITEM,RADFN,RADTI)) Q:'RADTI "RTN","RABWORD1",111,0) ...S RACNI=$O(^RADPT("AO",RAITEM,RADFN,RADTI,RACNI)) Q:'RACNI "RTN","RABWORD1",112,0) ...S ZTQUEUED=1 "RTN","RABWORD1",113,0) ...D UNCOMPL^RAPCE1(RADFN,RADTI,RACNI) "RTN","RABWORD1",114,0) ...D:$P($G(^RADPT(RADFN,"DT",0)),U,5) COMPLETE^RAPCE(RADFN,RADTI,RACNI) "RTN","RABWORD1",115,0) K RADFN,RAITEM,RAORIEN,RASCEI,RABWDX,RADX "RTN","RABWORD1",116,0) Q RAMSG "RTN","RAO7OKS") 0^3^B3815375 "RTN","RAO7OKS",1,0) RAO7OKS ;HISC/GJC-Accept/reject OE/RR request ;9/5/97 09:33 "RTN","RAO7OKS",2,0) ;;5.0;Radiology/Nuclear Medicine;**18,57**;Mar 16, 1998 "RTN","RAO7OKS",3,0) ;Last modified for P18 Oct 24 by SS "RTN","RAO7OKS",4,0) ACC(Y1,Y2,Y3,Y4,Y5) ; Rad accepts OE/RR request "RTN","RAO7OKS",5,0) ; Y1-> order control Y2-> universal service ID "RTN","RAO7OKS",6,0) ; Y3-> results rpt./stat. change DT Y4-> result status "RTN","RAO7OKS",7,0) ; Y5-> scheduled date/time "RTN","RAO7OKS",8,0) ; "RTN","RAO7OKS",9,0) ; PFSS 1B Project Account Referance Number "RTN","RAO7OKS",10,0) ; If the order status is "NEW", call to set up a new account number. "RTN","RAO7OKS",11,0) I RAORD="NW" D FB^RABWIBB(+RAORC3) ; Requirement 1, 5 "RTN","RAO7OKS",12,0) ; If the order status is "DISCONTINUE", call to set up a discontinue event "RTN","RAO7OKS",13,0) I RAORD="DC" D DC^RABWIBB(+RAORC3) ; Requirement 8 "RTN","RAO7OKS",14,0) ; "RTN","RAO7OKS",15,0) N MSG S MSG(1)=$$MSH^RAO7UTL("ORR") "RTN","RAO7OKS",16,0) S MSG(2)=$$MSA^RAO7UTL(+RAORC2,"AA") ;P18 add MSA segment with accept AA "RTN","RAO7OKS",17,0) S MSG(3)="PID"_$$STR^RAO7UTL(3)_$G(RAPID3)_$$STR^RAO7UTL(2)_$G(RAPID5) ;P18 "RTN","RAO7OKS",18,0) ; Add PV1 Segment for PFSS Project "RTN","RAO7OKS",19,0) ; PFSS 1B project define new field: PV1-50 Alternate Visit ID "RTN","RAO7OKS",20,0) S MSG(4)=$$PV1^RAO7UTL($G(^RAO(75.1,+RAORC3,0))) "RTN","RAO7OKS",21,0) S MSG(5)="ORC"_RAHLFS_Y1_RAHLFS_$G(RAORC2)_RAHLFS_$G(RAORC3) ;P18 "RTN","RAO7OKS",22,0) I Y2]""!(Y3]"")!(Y4]"")!(Y5]"") D ; include if order is scheduled "RTN","RAO7OKS",23,0) . S MSG(6)="OBR"_$$STR^RAO7UTL(4)_Y2_$$STR^RAO7UTL(18)_Y3 "RTN","RAO7OKS",24,0) . S MSG(6)=MSG(6)_$$STR^RAO7UTL(2)_Y4_$$STR^RAO7UTL(12)_Y5 "RTN","RAO7OKS",25,0) . Q "RTN","RAO7OKS",26,0) ; "RTN","RAO7OKS",27,0) D SHIP ; send HL7 message on its way to CPRS "RTN","RAO7OKS",28,0) Q "RTN","RAO7OKS",29,0) ; "RTN","RAO7OKS",30,0) REJ(Y1,Y2) ; Rad rejects OE/RR request "RTN","RAO7OKS",31,0) ; Y1-> order control Y2-> order control reason "RTN","RAO7OKS",32,0) N MSG S MSG(1)=$$MSH^RAO7UTL("ORR") "RTN","RAO7OKS",33,0) S MSG(2)=$$MSA^RAO7UTL(+RAORC2,"AR") ;P18 add MSA segment with reject AR "RTN","RAO7OKS",34,0) S MSG(3)="PID"_$$STR^RAO7UTL(3)_$G(RAPID3)_$$STR^RAO7UTL(2)_$G(RAPID5) ;P18 "RTN","RAO7OKS",35,0) S MSG(4)="ORC"_RAHLFS_Y1_RAHLFS_$G(RAORC2)_RAHLFS_$G(RAORC3) ;P18 "RTN","RAO7OKS",36,0) S:Y2]"" MSG(4)=MSG(4)_$$STR^RAO7UTL(13)_RAECH(1)_Y2_RAECH(1) "RTN","RAO7OKS",37,0) SHIP ; ship message to MSG^RAO7UTL which fires of the HL7 message to CPRS "RTN","RAO7OKS",38,0) D MSG^RAO7UTL("RA EVSEND OR",.MSG) "RTN","RAO7OKS",39,0) Q "RTN","RAO7UTL") 0^4^B26579249 "RTN","RAO7UTL",1,0) RAO7UTL ;HISC/GJC,SS-Utilities for HL7 messages. ;9/5/97 08:55 "RTN","RAO7UTL",2,0) ;;5.0;Radiology/Nuclear Medicine;**18,45,57**;Mar 16, 1998 "RTN","RAO7UTL",3,0) ;modified by SS JUN 19,2000 for P18 "RTN","RAO7UTL",4,0) EN1 ; Entry point to define some basic HL7 variables "RTN","RAO7UTL",5,0) N I S RAHLFS="|",RAECH="^~\&" "RTN","RAO7UTL",6,0) S $P(RAHLFS(0),RAHLFS,51)="" "RTN","RAO7UTL",7,0) F I=1:1:$L(RAECH) S RAECH(I)=$E(RAECH,I) "RTN","RAO7UTL",8,0) Q "RTN","RAO7UTL",9,0) ; "RTN","RAO7UTL",10,0) CMEDIA(IEN,RAPTYPE) ;Called from RAO7MFN when a procedure is updated "RTN","RAO7UTL",11,0) ;Input: IEN=ien of proc. in file 71 "RTN","RAO7UTL",12,0) ; RAPTYPE=procedure type; broad, parent, series, or detailed. "RTN","RAO7UTL",13,0) ;Return: J=a string with some combination of the following indicators: "RTN","RAO7UTL",14,0) ;I for Iodinated ionic, N for Iodinated non-ionic, L for Gadolinium "RTN","RAO7UTL",15,0) ;C for Oral Cholecystographic, G for Gastrografin, B for Barium or "RTN","RAO7UTL",16,0) ;NULL if none of the indicators apply to this procedure. "RTN","RAO7UTL",17,0) ; "RTN","RAO7UTL",18,0) ;'Broad' procedures have no contrast media definition, return null "RTN","RAO7UTL",19,0) Q:RAPTYPE="B" "" "RTN","RAO7UTL",20,0) ;if 'detailed' or 'series' & no contrast media data return null "RTN","RAO7UTL",21,0) I RAPTYPE'="P",'($O(^RAMIS(71,IEN,"CM",0))) Q "" "RTN","RAO7UTL",22,0) NEW I,INA,J S J="" "RTN","RAO7UTL",23,0) I RAPTYPE="P" D "RTN","RAO7UTL",24,0) .S I=0 F S I=$O(^RAMIS(71,IEN,4,I)) Q:'I D "RTN","RAO7UTL",25,0) ..S I(0)=+$G(^RAMIS(71,IEN,4,I,0)) Q:'I(0) "RTN","RAO7UTL",26,0) ..S INA=$P($G(^RAMIS(71,I(0),"I")),"^") "RTN","RAO7UTL",27,0) ..S INA=$S(INA="":1,INA>DT:1,1:0) "RTN","RAO7UTL",28,0) ..D:INA NONPAR(I(0)) "RTN","RAO7UTL",29,0) ..Q "RTN","RAO7UTL",30,0) .Q "RTN","RAO7UTL",31,0) E D NONPAR(IEN) "RTN","RAO7UTL",32,0) Q J "RTN","RAO7UTL",33,0) ; "RTN","RAO7UTL",34,0) NONPAR(IEN) ;obtain contrast media data for a 'detailed' or 'series' proc "RTN","RAO7UTL",35,0) ; Input: IEN=ien of the non-parent, non-broad procedure "RTN","RAO7UTL",36,0) ;Return: J=data string (return) "RTN","RAO7UTL",37,0) ;variable definition: I=ien of sub-file rec "RTN","RAO7UTL",38,0) NEW H,I S I=0 "RTN","RAO7UTL",39,0) F S I=$O(^RAMIS(71,IEN,"CM",I)) Q:I'>0 D "RTN","RAO7UTL",40,0) .S H=$P($G(^RAMIS(71,IEN,"CM",I,0)),U) Q:H="" "RTN","RAO7UTL",41,0) .S:J'[H J=J_H "RTN","RAO7UTL",42,0) .Q "RTN","RAO7UTL",43,0) Q "RTN","RAO7UTL",44,0) ; "RTN","RAO7UTL",45,0) MSH(X) ; Set up the 'MSH' segment. "RTN","RAO7UTL",46,0) ; 'X' is passed in and identifies the message type. "RTN","RAO7UTL",47,0) S:X']"" X="Message Type Error" "RTN","RAO7UTL",48,0) Q "MSH"_RAHLFS_RAECH_RAHLFS_"RADIOLOGY"_RAHLFS_$P($G(^DIC(4,+$G(DUZ(2)),99)),"^")_$$STR(3)_$$HLDATE^HLFNC($$NOW^XLFDT(),"TS")_$$STR(2)_X "RTN","RAO7UTL",49,0) ; "RTN","RAO7UTL",50,0) MSA(X,Y) ; Set up the 'MSA' segment. P18 "RTN","RAO7UTL",51,0) ; 'X' is passed in and identifies the message ID. "RTN","RAO7UTL",52,0) ; 'Y' is acknowledgement code "RTN","RAO7UTL",53,0) S:X']"" X="Message ID Error" "RTN","RAO7UTL",54,0) Q "MSA"_RAHLFS_Y_RAHLFS_$E(X,1,20)_$$STR(4) "RTN","RAO7UTL",55,0) MFI(X) ; Set up the 'MFI' segment "RTN","RAO7UTL",56,0) S @(RAVAR_RACNT_")")="MFI"_RAHLFS_RAFNUM "RTN","RAO7UTL",57,0) S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_RAFNAME_RAECH(1) "RTN","RAO7UTL",58,0) S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_"99DD"_RAHLFS_RAHLFS_X ;P18 "RTN","RAO7UTL",59,0) S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAHLFS_RAHLFS_RAHLFS_"ER" "RTN","RAO7UTL",60,0) X RAINCR ; increment counter "RTN","RAO7UTL",61,0) Q "RTN","RAO7UTL",62,0) PID(Y) ; Create 'pid' segment "RTN","RAO7UTL",63,0) Q "PID"_$$STR(3)_+$P(Y,"^")_$$STR(2)_$P($G(^DPT(+$P(Y,"^"),0)),"^") "RTN","RAO7UTL",64,0) ; "RTN","RAO7UTL",65,0) PV1(Y) ; Create 'pv1' segment "RTN","RAO7UTL",66,0) ;Input: Y=zero node of the RAD/NUC MED ORDERS (#75.1) file "RTN","RAO7UTL",67,0) N DFN,RA,RARMBED,RAWARD,VAIP,RAPF "RTN","RAO7UTL",68,0) S DFN=+$P(Y,"^"),VAIP("D")=$P(Y,"^",21) "RTN","RAO7UTL",69,0) S RA("PV1",2)="O",RA("PV1",3)=+$P(Y,"^",22) "RTN","RAO7UTL",70,0) D IN5^VADPT S RAWARD=$G(VAIP(5)),RARMBED=$G(VAIP(6)) "RTN","RAO7UTL",71,0) I RAWARD]"" D "RTN","RAO7UTL",72,0) . S RA("PV1",2)="I",RAWARD(44)=$P($G(^DIC(42,+RAWARD,44)),"^") "RTN","RAO7UTL",73,0) . S RA("PV1",3)=+RAWARD(44)_U_$P(RARMBED,"^",2) "RTN","RAO7UTL",74,0) . Q "RTN","RAO7UTL",75,0) S RAPF="PV1"_$$STR(2)_RA("PV1",2)_RAHLFS_RA("PV1",3)_$$STR(16) ;_"Visit #" was truncated for P18 ? Req 4 "RTN","RAO7UTL",76,0) D PV1^RABWIBB "RTN","RAO7UTL",77,0) ; pv1^RABWIBB will redefine RAPF if the PFSS switch is on and there's a valid PFSS Account Reference "RTN","RAO7UTL",78,0) ; Otherwise, RAPF won't be changed "RTN","RAO7UTL",79,0) K RACCOUNT ; this variable was set earlier in FB^RABWIBB "RTN","RAO7UTL",80,0) Q RAPF "RTN","RAO7UTL",81,0) ; "RTN","RAO7UTL",82,0) PURGE K RAHLFS,RACNT,RAECH,RAFNAME,RAFNUM,RAINCR,RASUB,RATSTMP,RAVAR,RAXIT "RTN","RAO7UTL",83,0) PURGE1 ; kill only whole file update variables "RTN","RAO7UTL",84,0) K RA71,RA713,RACMCODE,RACMNOR,RACOST,RACPT,RAIEN71,RAIMGAB,RAMFE,RAMULT "RTN","RAO7UTL",85,0) K RAPHYAP,RAPRCTY,RAXT71 "RTN","RAO7UTL",86,0) Q "RTN","RAO7UTL",87,0) DIAG(X,Y,Z) ; Pass back an "A" if any Dx code has 'Yes' in the 'Generate "RTN","RAO7UTL",88,0) ; Abnormal Alert' field. "RTN","RAO7UTL",89,0) N A,AAH,RA7003,RA783 S AAH="" "RTN","RAO7UTL",90,0) S RA7003=$G(^RADPT(X,"DT",Y,"P",Z,0)),RA7003(13)=+$P(RA7003,"^",13) "RTN","RAO7UTL",91,0) S RA783(0)=$G(^RA(78.3,RA7003(13),0)) "RTN","RAO7UTL",92,0) S RA783(4)=$$UP^XLFSTR($P(RA783(0),"^",4)) "RTN","RAO7UTL",93,0) S:RA783(4)="Y" AAH="A" "RTN","RAO7UTL",94,0) Q:AAH]"" AAH "RTN","RAO7UTL",95,0) S A=0 F S A=$O(^RADPT(X,"DT",Y,"P",Z,"DX",A)) Q:A'>0 D Q:AAH]"" "RTN","RAO7UTL",96,0) . S RA783=+$G(^RADPT(X,"DT",Y,"P",Z,"DX",A,0)) "RTN","RAO7UTL",97,0) . S RA783(0)=$G(^RA(78.3,RA783,0)) "RTN","RAO7UTL",98,0) . S RA783(4)=$$UP^XLFSTR($P(RA783(0),"^",4)) "RTN","RAO7UTL",99,0) . I RA783(4)="Y" S AAH="A" "RTN","RAO7UTL",100,0) . Q "RTN","RAO7UTL",101,0) Q AAH "RTN","RAO7UTL",102,0) PROCNDE(X) ; Check if the procedure has both an I-Type & Proc. Type "RTN","RAO7UTL",103,0) ; assigned. Pass back '1' if either the I-Type -or- Proc. Type "RTN","RAO7UTL",104,0) ; data is missing. '0' if everything is ok. "RTN","RAO7UTL",105,0) I $P(X(0),U,6)]"",($P(X(0),U,12)]"") Q 0 "RTN","RAO7UTL",106,0) Q 1 "RTN","RAO7UTL",107,0) STR(X) ; Pass back a predetermined # of '|' or other field separator "RTN","RAO7UTL",108,0) Q:$G(RAHLFS(0))']""!(+X=0) "" ; Quit if parent string i.e, 'RAHLFS(0)' "RTN","RAO7UTL",109,0) ; does not exist or +X evaluates to null. "RTN","RAO7UTL",110,0) ; "RTN","RAO7UTL",111,0) S:X<0 X=$$ABS^XLFMTH(X) ; If passed in negative, take absolute "RTN","RAO7UTL",112,0) ; value. Quit if 'X' is greater than the "RTN","RAO7UTL",113,0) ; length of our parent string. "RTN","RAO7UTL",114,0) ; "RTN","RAO7UTL",115,0) S:X["." X=X\1 ; If a non-integer, remove mantissa. "RTN","RAO7UTL",116,0) ; "RTN","RAO7UTL",117,0) Q:X>($L(RAHLFS(0))) "" ; If parameter greater than length of "RTN","RAO7UTL",118,0) ; string, pass back null. "RTN","RAO7UTL",119,0) Q $E(RAHLFS(0),1,X) "RTN","RAO7UTL",120,0) ; "RTN","RAO7UTL",121,0) CHKUSR(RADUZ) ; Check user status to 'DC' an order. "RTN","RAO7UTL",122,0) ; pass back '0' if non-active Rad/Nuc Med user "RTN","RAO7UTL",123,0) ; pass back '1' if active Rad/Nuc Med user "RTN","RAO7UTL",124,0) N RAINADT S RAINADT=+$P($G(^VA(200,RADUZ,"PS")),"^",4) ;inactivation DT "RTN","RAO7UTL",125,0) Q $S('($D(RADUZ)#2):0,'$D(^VA(200,RADUZ,0)):0,'$D(^("RAC")):0,'RAINADT:1,'$D(DT):0,DT'>RAINADT:1,1:0) "RTN","RAO7UTL",126,0) ; "RTN","RAO7UTL",127,0) ERR(RATXT,RAMSG,RAVAR) ; Call CPRS utility to log 'soft' errors. "RTN","RAO7UTL",128,0) ; Input: RATXT-text description of the error "RTN","RAO7UTL",129,0) ; RAMSG-HL7 message array "RTN","RAO7UTL",130,0) ; RAVAR-variables to be saved off "RTN","RAO7UTL",131,0) D EN^ORERR(RATXT,.RAMSG,.RAVAR) "RTN","RAO7UTL",132,0) Q "RTN","RAO7UTL",133,0) ; "RTN","RAO7UTL",134,0) MSG(RAPROTO,RAMSG) ; ship HL7 messages to CPRS from this entry point "RTN","RAO7UTL",135,0) ; input: RAPROTO - protocol to execute "RTN","RAO7UTL",136,0) ; RAMSG - message (in HL7 format) "RTN","RAO7UTL",137,0) D MSG^XQOR(RAPROTO,.RAMSG) "RTN","RAO7UTL",138,0) Q "RTN","RAO7UTL",139,0) ; "RTN","RAO7UTL",140,0) UPDATP(RAY) ;update the parent procedure when a descendent is "RTN","RAO7UTL",141,0) ;updated. Called from RAMAIN2 (procedure entry/edit) "RTN","RAO7UTL",142,0) ;input: RAY=ien of desc.^name of desc. (if existing record) "RTN","RAO7UTL",143,0) ; RAY=ien of desc.^name of desc.^1 (if new record) "RTN","RAO7UTL",144,0) W !!,$P(RAY,U,2)_" is a descendent procedure, updating parent(s)..." "RTN","RAO7UTL",145,0) N RAPIEN,RAQUIT S (RAPIEN,RAQUIT)=0 "RTN","RAO7UTL",146,0) F S RAPIEN=$O(^RAMIS(71,"ADESC",+RAY,RAPIEN)) Q:'RAPIEN D Q:RAQUIT "RTN","RAO7UTL",147,0) .S RAPIEN(0)=$G(^RAMIS(71,RAPIEN,0)) "RTN","RAO7UTL",148,0) .W !?2,"Updating parent: "_$E($P(RAPIEN(0),U),1,50) "RTN","RAO7UTL",149,0) .S RAPIEN("I")=$P($G(^RAMIS(71,RAPIEN,"I")),"^") "RTN","RAO7UTL",150,0) .S RAPIEN("S")=$S(RAPIEN("I")="":1,RAPIEN("I")>DT:1,1:0) "RTN","RAO7UTL",151,0) .L +^RAMIS(71,RAPIEN):300 "RTN","RAO7UTL",152,0) .I '$T S RAQUIT=1 D Q "RTN","RAO7UTL",153,0) ..W !?2,"Parent Procedure: "_$E($P(RAPIEN(0),U),1,50) "RTN","RAO7UTL",154,0) ..W !?2,"being edited by another user, try again later!",$C(7) "RTN","RAO7UTL",155,0) ..Q "RTN","RAO7UTL",156,0) .D PROC^RAO7MFN(0,71,RAPIEN("S")_"^"_RAPIEN("S"),RAPIEN) "RTN","RAO7UTL",157,0) .L -^RAMIS(71,RAPIEN) "RTN","RAO7UTL",158,0) .Q "RTN","RAO7UTL",159,0) Q "RTN","RAO7UTL",160,0) ; "RTN","RAORDU") 0^5^B27668360 "RTN","RAORDU",1,0) RAORDU ;HISC/CAH - AISC/RMO-Update Request Status ;9/7/04 11:01am "RTN","RAORDU",2,0) ;;5.0;Radiology/Nuclear Medicine;**18,41,57**;Mar 16, 1998 "RTN","RAORDU",3,0) ; last modif JULY 5,00 "RTN","RAORDU",4,0) ;The variables RAOIFN and RAOSTS must be defined. The variable "RTN","RAORDU",5,0) ;RAOREA is set when Canceling and Holding a request. The "RTN","RAORDU",6,0) ;variable RAOSCH is set when Scheduling a request. "RTN","RAORDU",7,0) ; RAOSTS=request status of exam "RTN","RAORDU",8,0) ; RAESTAT=min stat exams same dt/tm^max stat^1(if stat found) 0(else) "RTN","RAORDU",9,0) N RAESTAT "RTN","RAORDU",10,0) I RAOSTS=2,($$PARNT^RASETU(RAOIFN,RADFN)),($P($G(RAEXM0),"^",25)) D Q:RAOSTS=6 "RTN","RAORDU",11,0) . S RAESTAT=$$EN1^RASETU(RAOIFN,RADFN) "RTN","RAORDU",12,0) . S RAOSTS=$S((+RAESTAT'<1)&(+RAESTAT'>8):6,1:RAOSTS) "RTN","RAORDU",13,0) . K:RAOSTS=6 ORIFN,ORETURN "RTN","RAORDU",14,0) . I '$D(RAF1),(+RAESTAT=9) D "RTN","RAORDU",15,0) .. W !?3,"...will now designate request status as 'COMPLETE'..." "RTN","RAORDU",16,0) .. W !?10,"...request status successfully updated." "RTN","RAORDU",17,0) .. Q "RTN","RAORDU",18,0) . Q "RTN","RAORDU",19,0) I $D(ORSTS),ORSTS=11,$P(^RAO(75.1,RAOIFN,0),"^",5)=11 S ORIFN=+$P(^(0),"^",7),ORSTS="K",DA=RAOIFN,DIK="^RAO(75.1," D DELETE,^DIK K DIK D:ORIFN ST^ORX K ORSTS Q "RTN","RAORDU",20,0) K N I $D(RAOREA)>1 S N=$S($D(RAOIFN):RAOIFN,$D(ORPK):ORPK,1:1) I '$D(RAOREA(N)) S N=$O(RAOREA(0)) "RTN","RAORDU",21,0) S DA=RAOIFN,DIE="^RAO(75.1,",DR="10///"_$S($D(RAOREA)&(RAOSTS=1!(RAOSTS=3)):"/^S X="_$S($D(N):RAOREA(N),1:RAOREA),'$D(^RAO(75.1,RAOIFN,0)):"",$P(^(0),"^",10):"@",1:"")_";I 1;5///^S X="_RAOSTS "RTN","RAORDU",22,0) I $D(RAVSTFLG),$D(RAVLEDTI) S DR=DR_";17///^S X="_(9999999.9999-RAVLEDTI) "RTN","RAORDU",23,0) S DR=DR_";18///^S X=""NOW"";23///"_$S($D(RAOSCH)&(RAOSTS=8):"^S X="_RAOSCH,'$D(^RAO(75.1,RAOIFN,0)):"",$P(^(0),"^",23):"@",1:"") "RTN","RAORDU",24,0) S RADIV=$$SITE(),RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0))) "RTN","RAORDU",25,0) I $D(^RA(79,+RADIV,.1)),$P(^(.1),"^",19)="y" D SETLOG "RTN","RAORDU",26,0) D ^DIE K DE,DQ,DIE,DR I $$ORVR^RAORDU()=2.5 S ORIFN=$S($D(^RAO(75.1,RAOIFN,0)):+$P(^(0),"^",7),1:0),ORETURN("ORSTS")=RAOSTS D:ORIFN RETURN^ORX K ORIFN,ORETURN "RTN","RAORDU",27,0) ; "RTN","RAORDU",28,0) ; if oe/rr v.3 or greater do the following "RTN","RAORDU",29,0) ; .send a discontinue or hold message to oe/rr if request status in file "RTN","RAORDU",30,0) ; 75.1 is discontinued (1) or hold (3). "RTN","RAORDU",31,0) ; .send a complete message to oe/rr if request status in file 75.1 is "RTN","RAORDU",32,0) ; complete. "RTN","RAORDU",33,0) ; .send a scheduled message to oe/rr if request status is active (6) or "RTN","RAORDU",34,0) ; scheduled (8) AND the request was not a rollback from a status of "RTN","RAORDU",35,0) ; complete. "RTN","RAORDU",36,0) ; "RTN","RAORDU",37,0) I $$ORVR^RAORDU()'<3 D "RTN","RAORDU",38,0) . D:(RAOSTS=1)!(RAOSTS=3) EN1^RAO7CH(RAOIFN) "RTN","RAORDU",39,0) . D:RAOSTS=2 EN1^RAO7CMP(RAOIFN) "RTN","RAORDU",40,0) . I (RAOSTS=6) Q:$G(RA18PCHG,0)=1 ;P18 quit if procedure was changed - do not send "SC" message,because "XX" have been sent already "RTN","RAORDU",41,0) . I ((RAOSTS=6)!(RAOSTS=8))&($P($G(RAORDB4),"^",5)'=2) D "RTN","RAORDU",42,0) .. D EN1^RAO7SCH(RAOIFN) "RTN","RAORDU",43,0) .. Q "RTN","RAORDU",44,0) . Q "RTN","RAORDU",45,0) ; ***** PCE changes follow ***** "RTN","RAORDU",46,0) I $$PCE^RAWORK(),(RAOSTS=2),$G(RASAVDR)'="[RA OVERRIDE]" D "RTN","RAORDU",47,0) . N RA7003 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAORDU",48,0) . Q:$P(RA7003,"^",24)="Y" ; quit if clinic stop credited "RTN","RAORDU",49,0) . ;BILLING AWARE PHASE II, NO LONGER SENDING TO PTF "RTN","RAORDU",50,0) . ;I $P(RA7003,"^",6)]"",($P(^DIC(42,$P(RA7003,"^",6),0),"^",3)'="D") Q "RTN","RAORDU",51,0) . ;omit quit since both inpatient and outpatient data are sent to PCE "RTN","RAORDU",52,0) . D COMPLETE^RAPCE(RADFN,RADTI,RACNI) "RTN","RAORDU",53,0) . Q "RTN","RAORDU",54,0) ; PFSS 1B project. If the request status is discontinue then send the delete event to IBB "RTN","RAORDU",55,0) I RAOSTS=1 D DC^RABWIBB(RAOIFN) ; Requirement 8 "RTN","RAORDU",56,0) Q "RTN","RAORDU",57,0) ; "RTN","RAORDU",58,0) SETLOG K N I $D(RAOREA)>1 S N=$S($D(RAOIFN):RAOIFN,$D(ORPK):ORPK,1:1) I '$D(RAOREA(N)) S N=$O(RAOREA(0)) "RTN","RAORDU",59,0) S DR=DR_";75///^S X=$$MIDNGHT^RAUTL5($$NOW^XLFDT())",DR(2,75.12)="2////^S X="_RAOSTS_";3////^S X="_$S($G(RADUZ):RADUZ,1:DUZ)_";4///"_$S($D(RAOREA)&(RAOSTS=1!(RAOSTS=3)):"/^S X="_$S($D(N):RAOREA(N),1:RAOREA),1:"") "RTN","RAORDU",60,0) Q "RTN","RAORDU",61,0) SETORD ;Create request in OE/RR file and add OE/RR order number to file 75.1 "RTN","RAORDU",62,0) ; if oe/rr v.3 or greater send an hl7 message when creating a new request/order. "RTN","RAORDU",63,0) I $$ORVR^RAORDU()'<3 D EN1^RAO7NEW(RAOIFN) Q "RTN","RAORDU",64,0) Q:$$ORVR^RAORDU()'=2.5 "RTN","RAORDU",65,0) N RAPRGST S RAPRGST=$P(RAORD0,"^",13) "RTN","RAORDU",66,0) K RAMOD S $P(RABLNK," ",41)="" F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RAMOD=$S('$D(RAMOD):$P(^(0),"^"),1:RAMOD_", "_$P(^(0),"^")) "RTN","RAORDU",67,0) I $$ORVR^RAORDU()=2.5 S (RAPRCD,ORTX(1))=$P($G(^RAMIS(71,+$P(RAORD0,"^",2),0)),"^")_"," D "RTN","RAORDU",68,0) .I $D(RAMOD) S ORTX(2)="Modifiers: "_$E(RAMOD,1,80)_"," "RTN","RAORDU",69,0) .S ORTX(3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_"," "RTN","RAORDU",70,0) .I $P(RAORD0,"^",19)]"" S X=$P(RAORD0,"^",19),ORTX(3)=ORTX(3)_" Transport: "_$S(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_"," "RTN","RAORDU",71,0) .I $D(RASEX),RASEX'="M" S ORTX(3)=ORTX(3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"") "RTN","RAORDU",72,0) S ORIT=$P(RAORD0,"^",2)_";RAMIS(71," "RTN","RAORDU",73,0) S DIC="^RA(79.2,",DIC(0)="N",X=+$P(^RAMIS(71,+$P(RAORD0,"^",2),0),"^",12) D ^DIC K DIC,RABLNK,RAMOD,RAPRCD S ORPURG=$S(Y<0:30,$D(^RA(79.2,+Y,.1)):+$P(^(.1),"^",6),1:30) "RTN","RAORDU",74,0) S ORVP=RADFN_";DPT(",ORL=RALIFN_";SC(",ORNP=RAPIFN S ORPCL=$O(^ORD(101,"B","RA OERR EXAM",0))_";ORD(101,",ORPK=RAOIFN,ORSTS=$P(RAORD0,"^",5),ORSTRT=$P(RAORD0,"^",21) D FILE^ORX "RTN","RAORDU",75,0) I $D(ORIFN),ORIFN]"" S DA=RAOIFN,DIE="^RAO(75.1,",DR="7////^S X="_ORIFN D ^DIE K DE,DQ,DIE,DR "RTN","RAORDU",76,0) Q "RTN","RAORDU",77,0) OERR ;Set ^XUTL("OR",$J,"RA",IFN of oerr,IFN of Rad/Nuc Med order) "RTN","RAORDU",78,0) I $D(ORIFN),ORIFN,$D(RAOIFN),RAOIFN S ^XUTL("OR",$J,"RA",ORIFN,RAOIFN)=RADIV "RTN","RAORDU",79,0) K RADR1 Q "RTN","RAORDU",80,0) DELETE W:'$D(ZTQUEUED) !,"Since this order has not been released will delete instead of cancel...",! "RTN","RAORDU",81,0) Q "RTN","RAORDU",82,0) ; "RTN","RAORDU",83,0) ORVR() ;returns version number of OE/RR "RTN","RAORDU",84,0) ;returns 0 if OE/RR is not installed "RTN","RAORDU",85,0) ; "RTN","RAORDU",86,0) ;Q 3.0 ;for testing purposes "RTN","RAORDU",87,0) Q $S('$D(^ORD(100.99,0)):0,'$D(^DD(100,0,"VR")):0,1:^("VR")) "RTN","RAORDU",88,0) ; "RTN","RAORDU",89,0) ORQUIK() ;returns 1 if CPRS Order Dialogue file 101.41 exists "RTN","RAORDU",90,0) ;this means the quick order conversion to file 101.41 has been "RTN","RAORDU",91,0) ;done and users should no longer be allowed to edit quick order "RTN","RAORDU",92,0) ;parameters in the Common Procedure file 71.3. The quick order "RTN","RAORDU",93,0) ;conversion can be done prior to installing 3.0 "RTN","RAORDU",94,0) Q $S('$D(^ORD(101.41,0)):0,1:1) "RTN","RAORDU",95,0) ; "RTN","RAORDU",96,0) SITE() ; Determine the value of RADIV "RTN","RAORDU",97,0) ; +$P(RA1,"^",22)=Requesting Location "RTN","RAORDU",98,0) ; +$P(RA2,"^",15)=Division (pntr to 40.8) "RTN","RAORDU",99,0) Q:$D(RADIV)#2 RADIV "RTN","RAORDU",100,0) N RA1,RA2,RADIVSON "RTN","RAORDU",101,0) S RA1=$G(^RAO(75.1,RAOIFN,0)) "RTN","RAORDU",102,0) S RA2=$G(^SC(+$P(RA1,"^",22),0)) "RTN","RAORDU",103,0) S RADIVSON=+$$SITE^VASITE(DT,+$P(RA2,"^",15)) "RTN","RAORDU",104,0) Q $S(RADIVSON<0:0,1:RADIVSON) "RTN","RAPCE") 0^6^B45053281 "RTN","RAPCE",1,0) RAPCE ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ;9/7/04 12:36pm "RTN","RAPCE",2,0) ;;5.0;Radiology/Nuclear Medicine;**10,17,21,26,41,57**;Mar 16, 1998 "RTN","RAPCE",3,0) Q "RTN","RAPCE",4,0) COMPLETE(RADFN,RADTI,RACNI) ; When an exam status changes to 'complete' "RTN","RAPCE",5,0) ; Input: RADFN-> Patient DFN, RADTI-> Exam Timestamp, RACNI-> Case IEN "RTN","RAPCE",6,0) ; NOTE: RACNI input param is ignored for exam sets (all cases under "RTN","RAPCE",7,0) ; an exam set are processed at once when order is complete) "RTN","RAPCE",8,0) ; $$DATA2PCE^PXAPI returns: 1 if no errors, else error condition "RTN","RAPCE",9,0) ; "RTN","RAPCE",10,0) K ^TMP("DIERR",$J),^TMP("RAPXAPI",$J) "RTN","RAPCE",11,0) N RA7002,RA7003,RA71,RA791,RACNT,RADTE,RAEARRY,RAPKG,RAVSIT,RABAD,RASTAT,RACPTM,RA,RA1,RARECMPL,RACNISAV "RTN","RAPCE",12,0) N RADUPRC,RACOMIEN,RASENT,RALCKFAL "RTN","RAPCE",13,0) S RALCKFAL=0 ; >0 if lock fails when : "RTN","RAPCE",14,0) ; 1= complt'g exam that's unique to other cases same dt/tm, if any "RTN","RAPCE",15,0) ; 2= complt'g exam that's a dupl of another cmplt'd exam (RESEND^RAPCE1) "RTN","RAPCE",16,0) ; 3= UNcompleting exam before deleting credit+visit pointers same dt/tm "RTN","RAPCE",17,0) S RAPKG=$O(^DIC(9.4,"B","RADIOLOGY/NUCLEAR MEDICINE",0)) "RTN","RAPCE",18,0) S RADTE=9999999.9999-RADTI,RACNT=0 "RTN","RAPCE",19,0) S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RAPCE",20,0) S RAXAMSET=+$P(RA7002,"^",5) ; is this part of an exam set? 1=YES "RTN","RAPCE",21,0) EN2 S RA791=$G(^RA(79.1,+$P(RA7002,"^",4),0)) "RTN","RAPCE",22,0) ; Initialize variables required for PFSS 1B project and check the switch status. "RTN","RAPCE",23,0) N RAPFSW,RACCOUNT S RAPFSW=$$SWSTAT^IBBAPI ; Requirement 12 "RTN","RAPCE",24,0) Q:+$P(RA791,"^",21)=2 ; no credit, quit "RTN","RAPCE",25,0) S RAEARRY="RAERROR" N @RAEARRY "RTN","RAPCE",26,0) LON ; lock at P level "RTN","RAPCE",27,0) 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 "RTN","RAPCE",28,0) I 'RAXAMSET G NONSET "RTN","RAPCE",29,0) ; exam set, grab all the completed records! "RTN","RAPCE",30,0) S RACNISAV=RACNI "RTN","RAPCE",31,0) S RACNI=0 "RTN","RAPCE",32,0) F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!($G(RABAD)) D "RTN","RAPCE",33,0) . 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 "RTN","RAPCE",34,0) . S RACNT=RACNT+1 D SETUP I $G(RABAD) Q "RTN","RAPCE",35,0) . D:'$D(^TMP("RAPXAPI",$J,"ENCOUNTER")) ENC(RACNT) "RTN","RAPCE",36,0) . D DX^RABWPCE($P(RA7003,U,11)) ; Ordering ICD Dx and related data. "RTN","RAPCE",37,0) . D PROC(RACNT) "RTN","RAPCE",38,0) . Q "RTN","RAPCE",39,0) S RACNI=RACNISAV ;restore value so unlock would work 012601 "RTN","RAPCE",40,0) I '$G(RABAD),$D(^TMP("RAPXAPI",$J)) D PCE(RADFN,RADTI,RACNI) "RTN","RAPCE",41,0) ;Missing data, send failure bulletin for ea case in set, don't attempt to send data to PCE "RTN","RAPCE",42,0) I $G(RABAD) W:'$D(ZTQUEUED)&('$D(RARECMPL)) !,"Unable to credit Exam set" D "RTN","RAPCE",43,0) . 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)) "RTN","RAPCE",44,0) G KOUT "RTN","RAPCE",45,0) NONSET ; non-exam sets "RTN","RAPCE",46,0) S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAPCE",47,0) D CKDUP^RAPCE1 ; chk for duplicate procedure(s) non-examset "RTN","RAPCE",48,0) I $G(RADUPRC) D RESEND^RAPCE1 G KOUT ; branch off to re-send rec(s) this dt/tm "RTN","RAPCE",49,0) S RACNT=RACNT+1 "RTN","RAPCE",50,0) D SETUP "RTN","RAPCE",51,0) 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) "RTN","RAPCE",52,0) 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 "RTN","RAPCE",53,0) ; "RTN","RAPCE",54,0) KOUT K ^TMP("RAPXAPI",$J) "RTN","RAPCE",55,0) L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) "RTN","RAPCE",56,0) Q "RTN","RAPCE",57,0) ENC(X) ; Set up the '"RAPXAPI",$J,"ENCOUNTER"' nodes "RTN","RAPCE",58,0) N RAIMGLOC,RA17,RARPTLOC "RTN","RAPCE",59,0) S RA17=+$P(RA7003,U,17) "RTN","RAPCE",60,0) S RARPTLOC=$P($G(^RARPT(RA17,"BA")),U,1) "RTN","RAPCE",61,0) S RAIMGLOC=$P($G(^RA(79.1,+RARPTLOC,0)),"^") "RTN","RAPCE",62,0) S:'RAIMGLOC RAIMGLOC=$P($G(^RA(79.1,+$P(RA7002,"^",4),0)),"^") "RTN","RAPCE",63,0) I RAIMGLOC="" S RABAD=1 Q ; needs imaging location "RTN","RAPCE",64,0) S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"PATIENT")=RADFN "RTN","RAPCE",65,0) S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"ENC D/T")=RADTE "RTN","RAPCE",66,0) S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"HOS LOC")=RAIMGLOC "RTN","RAPCE",67,0) S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"SERVICE CATEGORY")="X" "RTN","RAPCE",68,0) S ^TMP("RAPXAPI",$J,"ENCOUNTER",X,"ENCOUNTER TYPE")="A" "RTN","RAPCE",69,0) Q "RTN","RAPCE",70,0) PCE(RADFN,RADTI,RACNI) ; Pass on the information to the PCE software "RTN","RAPCE",71,0) N RASULT "RTN","RAPCE",72,0) ; If the PFSS switch is not active then do not pass RACCOUNT parameter to DATA2PCE call. "RTN","RAPCE",73,0) I 'RAPFSW S RASULT=$$DATA2PCE^PXAPI("^TMP(""RAPXAPI"",$J)",RAPKG,"RAD/NUC MED",.RAVSIT,"","","","",.@RAEARRY) "RTN","RAPCE",74,0) ; If the PFSS switch is active then use RACCOUNT parameter in DATA2PCE call. "RTN","RAPCE",75,0) I RAPFSW D "RTN","RAPCE",76,0) . ; PFSS Requirement 6, 11 "RTN","RAPCE",77,0) . S RASULT=$$DATA2PCE^PXAPI("^TMP(""RAPXAPI"",$J)",RAPKG,"RAD/NUC MED",.RAVSIT,"","","","",.@RAEARRY,.RACCOUNT) "RTN","RAPCE",78,0) . Q "RTN","RAPCE",79,0) I (RASULT=1)!(RASULT=-1) D ;Visit file pointer, set 'Credit recorded' to yes. "RTN","RAPCE",80,0) . W:'$D(ZTQUEUED)&('$D(RARECMPL)) !?5,"Visit credited.",! "RTN","RAPCE",81,0) . D:'RAXAMSET VISIT(RADFN,RADTI,RACNI,RAVSIT) "RTN","RAPCE",82,0) . D:'RAXAMSET RECDCS(RADFN,RADTI,RACNI) ; only one exam, not a set "RTN","RAPCE",83,0) . D:RAXAMSET MULCS(RADFN,RADTI) ; set, update all exams! "RTN","RAPCE",84,0) . S RASENT=1 ; sent to PCE was okay "RTN","RAPCE",85,0) . Q "RTN","RAPCE",86,0) E D "RTN","RAPCE",87,0) . N RAWHOERR S RAWHOERR="" "RTN","RAPCE",88,0) . W:'$D(ZTQUEUED)&('$D(RARECMPL)) !?5,$C(7),"Unable to credit.",! "RTN","RAPCE",89,0) . I '$G(RAXAMSET) D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) "RTN","RAPCE",90,0) . I $G(RAXAMSET) D "RTN","RAPCE",91,0) .. 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)) "RTN","RAPCE",92,0) .. Q "RTN","RAPCE",93,0) . Q "RTN","RAPCE",94,0) Q "RTN","RAPCE",95,0) MULCS(RADFN,RADTI) ; Update the 'Credit recorded' field and the Visit "RTN","RAPCE",96,0) ;pointer for each case that is complete "RTN","RAPCE",97,0) N RACNI S RACNI=0 "RTN","RAPCE",98,0) F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D "RTN","RAPCE",99,0) . Q:$P($G(^RA(72,+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3),0)),U,3)'=9 "RTN","RAPCE",100,0) . D RECDCS(RADFN,RADTI,RACNI) "RTN","RAPCE",101,0) . D VISIT(RADFN,RADTI,RACNI,RAVSIT) "RTN","RAPCE",102,0) . Q "RTN","RAPCE",103,0) Q "RTN","RAPCE",104,0) PROC(X) ; Set up the other '"RAPXAPI",$J,"PROCEDURE"' nodes for this case "RTN","RAPCE",105,0) ; If same procedure repeated in exam set, add to qty of existing "RTN","RAPCE",106,0) ; 'procedure' node. Else, if different provider, create new "RTN","RAPCE",107,0) ; separate 'procedure' nodes "RTN","RAPCE",108,0) 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 "RTN","RAPCE",109,0) . S ^TMP("RAPXAPI",$J,"PROCEDURE",X1,"QTY")=^("QTY")+1 "RTN","RAPCE",110,0) . D CPTMOD(X1) "RTN","RAPCE",111,0) . S RADUP=1 "RTN","RAPCE",112,0) . Q "RTN","RAPCE",113,0) I $D(RADUP) Q "RTN","RAPCE",114,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"QTY")=1 "RTN","RAPCE",115,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"PROCEDURE")=$P(RA71,"^",9) "RTN","RAPCE",116,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"NARRATIVE")=$P(RA71,"^") "RTN","RAPCE",117,0) 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 "RTN","RAPCE",118,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"ORD PROVIDER")=RA7003(14) ; Requesting Physician. "RTN","RAPCE",119,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"EVENT D/T")=RADTE "RTN","RAPCE",120,0) ; if the PFSS switch is active Get both Dept. Code and Account Reference Number (RACCOUNT) "RTN","RAPCE",121,0) I RAPFSW D GETDEPT^RABWIBB ; Requirement 9 "RTN","RAPCE",122,0) D CPTMOD(X) "RTN","RAPCE",123,0) D PROCDX^RABWPCE(X) ; Add Ordering ICD Dx to each Procedure. "RTN","RAPCE",124,0) Q "RTN","RAPCE",125,0) RECDCS(RADFN,RADTI,RACNI) ; Set 'Clinic Stop Recorded' to yes "RTN","RAPCE",126,0) ; (70.03, fld 23) "RTN","RAPCE",127,0) N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",23)="Y" "RTN","RAPCE",128,0) D FILE^DIE("K","RAFDA") "RTN","RAPCE",129,0) Q "RTN","RAPCE",130,0) SETUP ; Setup examination data node information "RTN","RAPCE",131,0) ; If no provider, or inactive CPT, fail "RTN","RAPCE",132,0) S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAPCE",133,0) S RA7003(12)=$P(RA7003,"^",12) ; Pri. Inter. Resident "RTN","RAPCE",134,0) S RA7003(14)=$P(RA7003,"^",14) ; Requesting Physician. "RTN","RAPCE",135,0) S RA7003(15)=$P(RA7003,"^",15) ; Pri. Inter. Staff "RTN","RAPCE",136,0) I (RA7003(12)="")&(RA7003(15)="") S RABAD=1 Q "RTN","RAPCE",137,0) S RA71=$G(^RAMIS(71,+$P(RA7003,"^",2),0)) "RTN","RAPCE",138,0) ; store CPT Modifiers' .01 value "RTN","RAPCE",139,0) 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 "RTN","RAPCE",140,0) ; find out if CPT code is active "RTN","RAPCE",141,0) I '$$ACTCODE^RACPTMSC(+$P(RA71,"^",9),$P(RA7002,"^")) S RABAD=1 "RTN","RAPCE",142,0) Q "RTN","RAPCE",143,0) VISIT(RADFN,RADTI,RACNI,RAVSIT) ; Stuff the Visit file pointer passed back "RTN","RAPCE",144,0) ; from $$DATA2PCE^PXAPI() into the Visit field (70.02, fld 6) "RTN","RAPCE",145,0) N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",27)=RAVSIT "RTN","RAPCE",146,0) D FILE^DIE("K","RAFDA") "RTN","RAPCE",147,0) Q "RTN","RAPCE",148,0) CPTMOD(X3) ;CPT Modifiers "RTN","RAPCE",149,0) ; CPT Mods for dupl. procedure+provider will be accounted for "RTN","RAPCE",150,0) ; however, same CPT Mod will overwrite previous CPT Mod "RTN","RAPCE",151,0) S ^TMP("RAPXAPI",$J,"PROCEDURE",X3,"MODIFIERS")="" ;prevent abend "RTN","RAPCE",152,0) S RA=0 "RTN","RAPCE",153,0) F S RA=$O(RACPTM(RA)) Q:'RA S ^TMP("RAPXAPI",$J,"PROCEDURE",X3,"MODIFIERS",RACPTM(RA))="" "RTN","RAPCE",154,0) Q "VER") 8.0^22.0 "^DD",75.1,75.1,90,0) PFSS ACCOUNT REFERENCE^RP375'I^IBBAA(375,^0;28^Q "^DD",75.1,75.1,90,3) This value is filled in by the system. Do NOT change the value of this field. "^DD",75.1,75.1,90,21,0) ^.001^4^4^3050728^^^ "^DD",75.1,75.1,90,21,1,0) This field points to the PFSS ACCOUNT file (#375). The value is returned "^DD",75.1,75.1,90,21,2,0) from the GETACCT^IBBAPI, which Radiology silently invokes whenever an "^DD",75.1,75.1,90,21,3,0) order is placed, whether from the Front Door (CPRS) or from the Back Door "^DD",75.1,75.1,90,21,4,0) (Vista Radiology). "^DD",75.1,75.1,90,23,0) ^^2^2^3050728^ "^DD",75.1,75.1,90,23,1,0) Calls referencing PFSS Account Reference (field 90 file #75.1)) "^DD",75.1,75.1,90,23,2,0) uses DBIA #4741 "^DD",75.1,75.1,90,"DT") 3050622 "^DD",79.2,79.2,90,0) PFSS Dept. Code^RFI^^0;6^K:$L(X)>3!($L(X)<3) X "^DD",79.2,79.2,90,3) Do NOT change the value of this field. "^DD",79.2,79.2,90,21,0) ^^2^2^3050622^ "^DD",79.2,79.2,90,21,1,0) The 3 character numeric code represents the Department Code used by the "^DD",79.2,79.2,90,21,2,0) PFSS project. "^DD",79.2,79.2,90,"DT") 3050622 "BLD",5987,6) ^56 **END** **END**