Released RA*5*40 SEQ #33 Extracted from mail message **KIDS**:RA*5.0*40^ **INSTALL NAME** RA*5.0*40 "BLD",4298,0) RA*5.0*40^RADIOLOGY/NUCLEAR MEDICINE^0^3030303^y "BLD",4298,1,0) ^^2^2^3030303^ "BLD",4298,1,1,0) Please refer to the patch description in FORUM regarding the installation "BLD",4298,1,2,0) of RA*5.0*40. "BLD",4298,4,0) ^9.64PA^^ "BLD",4298,"KRN",0) ^9.67PA^8989.52^19 "BLD",4298,"KRN",.4,0) .4 "BLD",4298,"KRN",.401,0) .401 "BLD",4298,"KRN",.402,0) .402 "BLD",4298,"KRN",.403,0) .403 "BLD",4298,"KRN",.5,0) .5 "BLD",4298,"KRN",.84,0) .84 "BLD",4298,"KRN",3.6,0) 3.6 "BLD",4298,"KRN",3.8,0) 3.8 "BLD",4298,"KRN",9.2,0) 9.2 "BLD",4298,"KRN",9.8,0) 9.8 "BLD",4298,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",4298,"KRN",9.8,"NM",1,0) RASTREQ^^0^B45271295 "BLD",4298,"KRN",9.8,"NM",2,0) RASTREQN^^0^B31958180 "BLD",4298,"KRN",9.8,"NM","B","RASTREQ",1) "BLD",4298,"KRN",9.8,"NM","B","RASTREQN",2) "BLD",4298,"KRN",19,0) 19 "BLD",4298,"KRN",19.1,0) 19.1 "BLD",4298,"KRN",101,0) 101 "BLD",4298,"KRN",409.61,0) 409.61 "BLD",4298,"KRN",771,0) 771 "BLD",4298,"KRN",870,0) 870 "BLD",4298,"KRN",8989.51,0) 8989.51 "BLD",4298,"KRN",8989.52,0) 8989.52 "BLD",4298,"KRN",8994,0) 8994 "BLD",4298,"KRN","B",.4,.4) "BLD",4298,"KRN","B",.401,.401) "BLD",4298,"KRN","B",.402,.402) "BLD",4298,"KRN","B",.403,.403) "BLD",4298,"KRN","B",.5,.5) "BLD",4298,"KRN","B",.84,.84) "BLD",4298,"KRN","B",3.6,3.6) "BLD",4298,"KRN","B",3.8,3.8) "BLD",4298,"KRN","B",9.2,9.2) "BLD",4298,"KRN","B",9.8,9.8) "BLD",4298,"KRN","B",19,19) "BLD",4298,"KRN","B",19.1,19.1) "BLD",4298,"KRN","B",101,101) "BLD",4298,"KRN","B",409.61,409.61) "BLD",4298,"KRN","B",771,771) "BLD",4298,"KRN","B",870,870) "BLD",4298,"KRN","B",8989.51,8989.51) "BLD",4298,"KRN","B",8989.52,8989.52) "BLD",4298,"KRN","B",8994,8994) "BLD",4298,"QUES",0) ^9.62^^ "BLD",4298,"REQB",0) ^9.611^1^1 "BLD",4298,"REQB",1,0) RA*5.0*23^2 "BLD",4298,"REQB","B","RA*5.0*23",1) "MBREQ") 0 "PKG",18,-1) 1^1 "PKG",18,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",18,20,0) ^9.402P^^ "PKG",18,22,0) ^9.49I^1^1 "PKG",18,22,1,0) 5.0^3011017^2980407^50 "PKG",18,22,1,"PAH",1,0) 40^3030303 "PKG",18,22,1,"PAH",1,1,0) ^^2^2^3030303 "PKG",18,22,1,"PAH",1,1,1,0) Please refer to the patch description in FORUM regarding the installation "PKG",18,22,1,"PAH",1,1,2,0) of RA*5.0*40. "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") 2 "RTN","RASTREQ") 0^1^B45271295 "RTN","RASTREQ",1,0) RASTREQ ;HISC/CAH,GJC AISC/MJK-Status Requirements Check Routine ;6/3/98 09:56 "RTN","RASTREQ",2,0) ;;5.0;Radiology/Nuclear Medicine;**1,10,23,40**;Mar 16, 1998 "RTN","RASTREQ",3,0) ; Called by "RTN","RASTREQ",4,0) ; (1) Stat Track's [RA STATUS CHANGE]'s fld EXAM STATUS' input transform "RTN","RASTREQ",5,0) ; (2) ASK+22^RASTED, if user "^" out of stat trk editing "RTN","RASTREQ",6,0) ; (3) Cancel an Exam's [RA CANCEL]'s fld EXAM STATUS' input transform "RTN","RASTREQ",7,0) ; (4) Enter Last Past Visit Before DHCP's [RA LAST PAST VISIT]'s "" "RTN","RASTREQ",8,0) ; "RTN","RASTREQ",9,0) ; Instead of using RAIMGTY, recalculate "RTN","RASTREQ",10,0) ; the imaging type using the imaging type on the exam node because "RTN","RASTREQ",11,0) ; status updating through report entry/edit, batch verify, and several "RTN","RASTREQ",12,0) ; other options is NOT screened by sign-on imaging type, so does not "RTN","RASTREQ",13,0) ; stay the same through a user's session. "RTN","RASTREQ",14,0) ; "RTN","RASTREQ",15,0) ; 'RAMES1' is used to display which Exam Status required fields are "RTN","RASTREQ",16,0) ; not populated. This only applies to the 'Status Tracking Of Exams' "RTN","RASTREQ",17,0) ; option. "RTN","RASTREQ",18,0) ; "RTN","RASTREQ",19,0) ; If tracking ^-out, this rtn would be called outside of edt tmpl, "RTN","RASTREQ",20,0) ; and thus the DA vars would not be defined, so we need to set them here "RTN","RASTREQ",21,0) ; "RTN","RASTREQ",22,0) S:'$D(DA)#2 DA=RACNI S:'$D(DA(1))#2 DA(1)=RADTI S:'$D(DA(2))#2 DA(2)=RADFN "RTN","RASTREQ",23,0) ; If Fileman enter/edit, we need to define RADFN, RADTI, RACNI so the "RTN","RASTREQ",24,0) ; nuc med checks won't bomb "RTN","RASTREQ",25,0) S:'$D(RACNI)#2 RACNI=DA S:'$D(RADTI)#2 RADTI=DA(1) S:'$D(RADFN)#2 RADFN=DA(2) "RTN","RASTREQ",26,0) ; "RTN","RASTREQ",27,0) S RAIMGTYI=+$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U,1),RASAVTYJ=RAIMGTYJ "RTN","RASTREQ",28,0) S RAMES1="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !?3,""No '"",RAZ,""'"",?35,"" entered for this exam.""" ; display if at the ranext exm stat level "RTN","RASTREQ",29,0) S RAXX=+$G(X) "RTN","RASTREQ",30,0) I '$D(^RA(72,RAXX,0))!(RAIMGTYJ']"") D Q "RTN","RASTREQ",31,0) . K X W:'$D(ZTQUEUED)#2 !?3,"Error: cannot determine Imaging Type of exam. Contact IRM." "RTN","RASTREQ",32,0) . K RAMES1,RAXX "RTN","RASTREQ",33,0) . Q "RTN","RASTREQ",34,0) N RA,RASN,RASTI,RADES,RAOKAY,RA3 "RTN","RASTREQ",35,0) ; RADES = order seq. desired, RAOKAY= actual order seq. okay'd "RTN","RASTREQ",36,0) S X1=$G(^RA(72,RAXX,0)),RADES=$P(X1,U,3) "RTN","RASTREQ",37,0) I $$LKUP^XPDKEY(+$P(X1,"^",4))]"",'$D(^XUSEC($$LKUP^XPDKEY(+$P(X1,"^",4)),DUZ)) K X W:'$D(ZTQUEUED)#2 !?3,"You do not have the proper access privileges to ",!?3,"change this exam to this status" Q "RTN","RASTREQ",38,0) S RAJ=^RADPT(DA(2),"DT",DA(1),"P",DA,0),RAOR=-1 "RTN","RASTREQ",39,0) S RABEFORE=$P($G(^RA(72,+$P(RAJ,U,3),0)),U,3) ; current order seq "RTN","RASTREQ",40,0) ; Don't need to set RAORDIFN,RACS,RAPRIT,RAF5 "RTN","RASTREQ",41,0) I '$D(^RA(72,"AA",RAIMGTYJ,0,RAXX)) D LOOP^RASTREQ1 S RAIMGTYJ=RASAVTYJ "RTN","RASTREQ",42,0) I $D(^RA(72,"AA",RAIMGTYJ,0,RAXX)) D CANCEL^RASTREQ1 "RTN","RASTREQ",43,0) S RAIMGTYJ=RASAVTYJ "RTN","RASTREQ",44,0) ; Can't use X to determine if status change to next was successful "RTN","RASTREQ",45,0) ; due to looping thru all status levels for this img type "RTN","RASTREQ",46,0) ; chk if calculated order is at NEXT or higher level "RTN","RASTREQ",47,0) ; RAAFTER is set in rastreq1; it has 2 meanings : "RTN","RASTREQ",48,0) ; upon return from rastreq1, RAAFTER means highest seq order qualified "RTN","RASTREQ",49,0) ; upon exit from this rtn, RAAFTER means actual seq order used "RTN","RASTREQ",50,0) I RABEFORERAAFTER W:'$D(ZTQUEUED)#2 ?$X+4,$P($G(^RA(72,$O(^(RA3,0)),0)),U) "RTN","RASTREQ",70,0) W:'$D(ZTQUEUED)#2 !!,"Since Status Tracking can only upgrade one status at a time,",!,"please edit this exam again.",! "RTN","RASTREQ",71,0) KOUT2 S RAAFTER=RAOKAY ;return as actual seq order used, not nec. highest "RTN","RASTREQ",72,0) K RAIMGTYI,RAIMGTYJ,RAMES1,RAZ,RAXX,RAJ,RAS,RAK,RAE,X1,RASAVTYJ "RTN","RASTREQ",73,0) Q "RTN","RASTREQ",74,0) ; "RTN","RASTREQ",75,0) 1 ;Technologist Check "RTN","RASTREQ",76,0) S RA("TECH")="" I $O(^RADPT(DA(2),"DT",DA(1),"P",DA,"TC",0))>0,$D(^VA(200,+^($O(^(0)),0),0)) S RA("TECH")=$P(^(0),"^") "RTN","RASTREQ",77,0) I RA("TECH")']"" K X S RAZ="technologist" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",78,0) K RA("TECH") Q "RTN","RASTREQ",79,0) ; "RTN","RASTREQ",80,0) 2 ;Interpreting Physician Check "RTN","RASTREQ",81,0) I '$D(^VA(200,+$P(RAJ,"^",12),0)),'$D(^VA(200,+$P(RAJ,"^",15),0)) K X S RAZ="interpreting staff or resident" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",82,0) Q "RTN","RASTREQ",83,0) ; "RTN","RASTREQ",84,0) 3 ;Detailed Procedure Check "RTN","RASTREQ",85,0) S RAZ="detailed procedure" I '$D(^RAMIS(71,+$P(RAJ,"^",2),0)) K X X:$D(RAMES1) RAMES1 Q "RTN","RASTREQ",86,0) S RAJ1=$G(^RAMIS(71,+$P(RAJ,"^",2),0)) I "DS"'[$P(RAJ1,"^",6) K X X:$D(RAMES1) RAMES1 Q "RTN","RASTREQ",87,0) S RAZ="detailed procedure (no CPT code)" I $P(RAJ1,"^",9)']"" K X X:$D(RAMES1) RAMES1 Q "RTN","RASTREQ",88,0) Q "RTN","RASTREQ",89,0) ; "RTN","RASTREQ",90,0) 4 ;Film Data Check "RTN","RASTREQ",91,0) I '$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"F",0)) K X S RAZ="film data" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",92,0) Q "RTN","RASTREQ",93,0) ; "RTN","RASTREQ",94,0) 5 ;Diagnostic Code Check "RTN","RASTREQ",95,0) I '$D(^RA(78.3,+$P(RAJ,"^",13),0)) K X S RAZ="diagnostic code" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",96,0) Q "RTN","RASTREQ",97,0) ; "RTN","RASTREQ",98,0) 6 ;Camera/Equipment/Room Check "RTN","RASTREQ",99,0) S RAE=$S($D(RAMDV):$P(RAMDV,"^",9),1:1) I RAE,'$D(^RA(78.6,+$P(RAJ,"^",18),0)) K X S RAZ="camera/equip/room" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",100,0) Q "RTN","RASTREQ",101,0) ; "RTN","RASTREQ",102,0) 11 ;Report Entered and not just a stub rec for Img/PACS Check "RTN","RASTREQ",103,0) I '$D(^RARPT(+$P(RAJ,"^",17),0)) G NORPT "RTN","RASTREQ",104,0) ; since there's a rpt ptr, must check if the rpt is just a stub rpt "RTN","RASTREQ",105,0) N RA17,RA0 ; use logic from RAREG "RTN","RASTREQ",106,0) S RA17=+$P(RAJ,"^",17) "RTN","RASTREQ",107,0) I $$STUB^RAEDCN1(RA17) G NORPT ; rpt is an image stub "RTN","RASTREQ",108,0) Q "RTN","RASTREQ",109,0) NORPT ; either no report yet, or report is stub "RTN","RASTREQ",110,0) K X S RAZ="report" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",111,0) Q "RTN","RASTREQ",112,0) ; "RTN","RASTREQ",113,0) 12 ;Report Verified Check "RTN","RASTREQ",114,0) D 11:$P(RAS,"^",11)'="Y" I $D(^RARPT(+$P(RAJ,"^",17),0)),$P(^(0),"^",5)'="V" K X S RAZ="report verification" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",115,0) Q "RTN","RASTREQ",116,0) ; "RTN","RASTREQ",117,0) 16 ;Impression Entry Check "RTN","RASTREQ",118,0) I $O(^RARPT(+$P(RAJ,"^",17),"I",0))'>0 K X S RAZ="impression" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",119,0) Q "RTN","RASTREQ",120,0) 13 ;Procedure Modifers Check "RTN","RASTREQ",121,0) I '$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"M",0)) K X S RAX="procedure modifier" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",122,0) Q "RTN","RASTREQ",123,0) 14 ;CPT Modifiers Check "RTN","RASTREQ",124,0) I '$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CMOD",0)) K X S RAZ="CPT modifiers" X:$D(RAMES1) RAMES1 "RTN","RASTREQ",125,0) Q "RTN","RASTREQ",126,0) ; "RTN","RASTREQ",127,0) HELP ; Called from 'Help Text' node in DD(70.03,3,4). "RTN","RASTREQ",128,0) N E,RA "RTN","RASTREQ",129,0) S RAJ=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0)) "RTN","RASTREQ",130,0) S RAIMGTYI=+$P($G(^RADPT(DA(2),"DT",DA(1),0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U,1) "RTN","RASTREQ",131,0) I RAIMGTYJ']"" W !,"ERROR: Cannot determine imaging type of exam!" K FL,K,N,RAIMGTYI,RAIMGTYJ,RAS,RAJ Q "RTN","RASTREQ",132,0) W !,"This exam meets the requirements for the following statuses:" "RTN","RASTREQ",133,0) F K=0:0 S K=$O(^RA(72,"AA",RAIMGTYJ,K)) Q:K'>0 D "RTN","RASTREQ",134,0) . S X="",E=+$O(^RA(72,"AA",RAIMGTYJ,K,0)) Q:E'>0 "RTN","RASTREQ",135,0) . I $D(^RA(72,E,0)) D "RTN","RASTREQ",136,0) .. S RA(0)=$G(^RA(72,E,0)),N=$P(RA(0),U),RAS=$G(^RA(72,E,.1)) "RTN","RASTREQ",137,0) .. I $L(RAS) D HELP1 D:$D(X)&($P(RAS,"^",3)'="Y")&($D(^RA(72,"AA",RAIMGTYJ,9,E))) 3 I $D(X) W !?10,N S FL="" "RTN","RASTREQ",138,0) .. Q "RTN","RASTREQ",139,0) . Q "RTN","RASTREQ",140,0) W:'$D(FL) !?10,"Does not meet the requirements of any status." "RTN","RASTREQ",141,0) W ! K RAS,RAJ,N,K,FL,RAIMGTYI,RAIMGTYJ "RTN","RASTREQ",142,0) Q "RTN","RASTREQ",143,0) HELP1 ; Called from 'HELP' above and 'STUFF^RASTREQ1' "RTN","RASTREQ",144,0) ; 'RAJ' -> 0 node of the examination "RTN","RASTREQ",145,0) ; 'E' -> ien of the examination status "RTN","RASTREQ",146,0) ; Both 'RAJ' & 'E' set in 'HELP' & 'STUFF^RASTREQ1' "RTN","RASTREQ",147,0) N RADIO,RADIOUZD S RADIO=$S($G(^RA(72,E,.5))]"":$G(^(.5)),1:"N") "RTN","RASTREQ",148,0) S:$P($G(^RA(79.2,+RAIMGTYI,0)),"^",5)="Y" RADIOUZD="" "RTN","RASTREQ",149,0) F RAK=1:1 Q:$P(RAS,"^",RAK,99)']"" D:$P(RAS,"^",RAK)="Y" @RAK "RTN","RASTREQ",150,0) I $D(X),$P(RAS,"^",3)'="Y",$D(^RA(72,"AA",RAIMGTYJ,9,E)) D 3 "RTN","RASTREQ",151,0) I $D(X),$P(RAS,"^",16)'="Y",$D(^RA(72,"AA",RAIMGTYJ,9,E)),$D(^RA(79,+$P(^RADPT(DA(2),"DT",DA(1),0),"^",3),.1)),$P(^(.1),"^",16)="Y" D 16 "RTN","RASTREQ",152,0) I $D(RADIOUZD),($D(X)) D "RTN","RASTREQ",153,0) . D EN1^RASTREQN(RADIO,RAJ) "RTN","RASTREQ",154,0) . I $D(X),($$UP^XLFSTR($P($G(^RA(72,E,.6)),"^",11)="Y")) D EN1^RADOSTIK(RADFN,RADTI,RACNI) "RTN","RASTREQ",155,0) . Q "RTN","RASTREQ",156,0) Q "RTN","RASTREQN") 0^2^B31958180 "RTN","RASTREQN",1,0) RASTREQN ;HIRMFO/GJC-Status Requirement check for Radiopharms ;11/18/97 15:13 "RTN","RASTREQN",2,0) ;;5.0;Radiology/Nuclear Medicine;**40**;Mar 16, 1998 "RTN","RASTREQN",3,0) ; "RTN","RASTREQN",4,0) ; *** 'RASTREQN' is called from routine: 'RASTREQ' *** "RTN","RASTREQN",5,0) EN1(RADIO,RAJ) ; Check if all the required radiopharmaceutical data has "RTN","RASTREQN",6,0) ; been entered for this particular Examination Status. "RTN","RASTREQN",7,0) ; *=*=*= Kills 'X' if the status cannot be updated =*=*=* "RTN","RASTREQN",8,0) ; Input: 'RADIO' -> .5 node of the examination status (Radiopharms req) "RTN","RASTREQN",9,0) ; 'RAJ' -> 0 node of the examination "RTN","RASTREQN",10,0) ; "RTN","RASTREQN",11,0) ; NOTE: RAMES1 is set in RASTREQ^RASTREQ subroutine. Only the 'Status "RTN","RASTREQN",12,0) ; Tracking Of Exams' option displays which required fields are not "RTN","RASTREQN",13,0) ; populated for the next available Exam Status. "RTN","RASTREQN",14,0) ; "RTN","RASTREQN",15,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",16,0) ; Determine if 'Radiopharmaceutical' is required "RTN","RASTREQN",17,0) ; RAPRI defined in [RA STATUS CHANGE] & [RA EXAM EDIT] "RTN","RASTREQN",18,0) ; "RTN","RASTREQN",19,0) Q:"N"[$P(RADIO,"^") ; Rpharms & Dosages NOT Req'd (either 'no' or null) "RTN","RASTREQN",20,0) N RAPROC S RAPROC(0)=$G(^RAMIS(71,+$P(RAJ,"^",2),0)) "RTN","RASTREQN",21,0) Q:$P(RAPROC(0),"^",2)=1 ; Never ask Rpharms & Dosages "RTN","RASTREQN",22,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",23,0) N RA702 S RA702=+$P(RAJ,"^",28) ; ien in NUC MED EXAM DATA (70.2) file "RTN","RASTREQN",24,0) N RA7021,RACNT,RAI,RAMES2,RAREQ,RAZ S RAI=0 W:'$D(ZTQUEUED)#2 ! "RTN","RASTREQN",25,0) I 'RA702,($P(RADIO,"^")="Y") D Q "RTN","RASTREQN",26,0) . K X S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",27,0) . Q "RTN","RASTREQN",28,0) F S RAI=$O(^RADPTN(RA702,"NUC",RAI)) Q:RAI'>0 D "RTN","RASTREQN",29,0) . S RA7021=$G(^RADPTN(RA702,"NUC",RAI,0)),RACNT=0 "RTN","RASTREQN",30,0) . S RAMES2="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !,""Radiopharmaceutical: "",$$GET1^DIQ(50,+$P(RA7021,""^"")_"","",.01)" "RTN","RASTREQN",31,0) . I $P(RADIO,"^")="Y",($P(RA7021,"^")=""!($P(RA7021,"^",7)="")) D "RTN","RASTREQN",32,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",33,0) .. I $P(RA7021,"^")="" S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",34,0) .. I $P(RA7021,"^",7)="" S RAZ="Dosage" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",35,0) .. Q "RTN","RASTREQN",36,0) . I $P(RADIO,"^",3)="Y",($P(RA7021,"^",4)="") D "RTN","RASTREQN",37,0) .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",38,0) .. S RAZ="Activity Drawn" X:$D(RAMES1) RAMES1 K X "RTN","RASTREQN",39,0) .. Q "RTN","RASTREQN",40,0) . I $P(RADIO,"^",4)="Y",($P(RA7021,"^",5)=""!($P(RA7021,"^",6)="")) D "RTN","RASTREQN",41,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",42,0) .. I $P(RA7021,"^",5)="" S RAZ="Date/Time Drawn" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",43,0) .. I $P(RA7021,"^",6)="" S RAZ="Person Who Measured Dose" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",44,0) .. Q "RTN","RASTREQN",45,0) . I $P(RADIO,"^",5)="Y",($P(RA7021,"^",8)=""!($P(RA7021,"^",9)="")) D "RTN","RASTREQN",46,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",47,0) .. I $P(RA7021,"^",8)="" S RAZ="Date/Time Dose Administered" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",48,0) .. I $P(RA7021,"^",9)="" S RAZ="Person Who Administered Dose" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",49,0) .. Q "RTN","RASTREQN",50,0) . I $P(RADIO,"^",7)="Y",($P(RA7021,"^",11)=""!($P(RA7021,"^",12)="")) D "RTN","RASTREQN",51,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",52,0) .. I $P(RA7021,"^",11)="" S RAZ="Route Of Administration" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",53,0) .. I $P(RA7021,"^",12)="" S RAZ="Site Of Administration" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",54,0) .. Q "RTN","RASTREQN",55,0) . I $P(RADIO,"^",8)="Y",($P(RA7021,"^",13)="") D "RTN","RASTREQN",56,0) .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",57,0) .. S RAZ="Lot No." X:$D(RAMES1) RAMES1 K X "RTN","RASTREQN",58,0) .. Q "RTN","RASTREQN",59,0) . I $P(RADIO,"^",9)="Y",($P(RA7021,"^",14)=""!($P(RA7021,"^",15)="")) D "RTN","RASTREQN",60,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",61,0) .. I $P(RA7021,"^",14)="" S RAZ="Volume" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",62,0) .. I $P(RA7021,"^",15)="" S RAZ="Form" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",63,0) .. Q "RTN","RASTREQN",64,0) . W:'$D(ZTQUEUED)#2 ! ; spacing "RTN","RASTREQN",65,0) . Q "RTN","RASTREQN",66,0) Q "RTN","RASTREQN",67,0) NORADIO(RAPRI,RANXT72) ; This function will determine if Rpharm "RTN","RASTREQN",68,0) ; fields from the 'Nuc Med Exam Data' file [ ^RADPTN( ] will be asked. "RTN","RASTREQN",69,0) ; Input : 'RANXT72' -> .6 node of the 'Next' Exam Status "RTN","RASTREQN",70,0) ; : 'RAPRI' -> IEN of the procedure for this exam "RTN","RASTREQN",71,0) ; Output: '1' bypass Rpharm questions, else (0) ask "RTN","RASTREQN",72,0) Q:$TR($$UP^XLFSTR(RANXT72(.6)),"^","")="" 1 ; null or '^'s "RTN","RASTREQN",73,0) ; ------------------- Variable Definitions ---------------------------- "RTN","RASTREQN",74,0) ; 'RAPROC(2)': ask Rpharm & Dosages parameter for this procedure "RTN","RASTREQN",75,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",76,0) N RAPROC S RAPROC(2)=$P($G(^RAMIS(71,RAPRI,0)),"^",2) "RTN","RASTREQN",77,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",78,0) ; * following conditions apply for descendants exams & single exams * "RTN","RASTREQN",79,0) ; * Number 1: Suppress Rpharm = 1 even if 'Rpharms/Dose' Req'd * "RTN","RASTREQN",80,0) ; * Number 2: Suppress Rpharm = null or 0, 'Rpharm/Dose' not req'd * "RTN","RASTREQN",81,0) Q:RAPROC(2)=1 1 "RTN","RASTREQN",82,0) Q:"N"[$P(RANXT72(.6),"^") 1 "RTN","RASTREQN",83,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",84,0) Q 0 ; ask Rpharm & Dosage fields "RTN","RASTREQN",85,0) DISDEF(RADA) ; Display Radiopharmaceutical default data "RTN","RASTREQN",86,0) ; Input: RADA -> ien of the Nuc Med Exam Data record "RTN","RASTREQN",87,0) Q:'$O(^RADPTN(RADA,"NUC",0)) ; Radiopharms missing, no data "RTN","RASTREQN",88,0) N RADARY,RADEUC,RAFLDS,RAIENS,RAOPUT,X,Y W ! "RTN","RASTREQN",89,0) S RAIENS="" D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") "RTN","RASTREQN",90,0) F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D "RTN","RASTREQN",91,0) . Q:$P(RAIENS,",",2)="" ; top-level of the file "RTN","RASTREQN",92,0) . S (RADEUC,RAFLDS)=0 "RTN","RASTREQN",93,0) . F S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0 D Q:$D(DIRUT) "RTN","RASTREQN",94,0) .. I RAFLDS=.01 D "RTN","RASTREQN",95,0) ... S RADEUC=0 W !,$G(RADARY(70.21,RAIENS,RAFLDS,"E")) "RTN","RASTREQN",96,0) ... W !,$$REPEAT^XLFSTR("-",$L($G(RADARY(70.21,RAIENS,RAFLDS,"E")))),! "RTN","RASTREQN",97,0) ... Q "RTN","RASTREQN",98,0) .. E D "RTN","RASTREQN",99,0) ... S RADEUC=RADEUC+1 "RTN","RASTREQN",100,0) ... S RAOPUT=$$TRAN(RAFLDS)_$G(RADARY(70.21,RAIENS,RAFLDS,"E"))_$S(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"") "RTN","RASTREQN",101,0) ... W:RADEUC=1 $E(RAOPUT,1,38) W:RADEUC=2 ?39,$E(RAOPUT,1,39) "RTN","RASTREQN",102,0) ... Q "RTN","RASTREQN",103,0) .. W:RADEUC'=2&($O(RADARY(70.21,RAIENS,RAFLDS))="") ! "RTN","RASTREQN",104,0) .. W:RADEUC=2 ! S:RADEUC=2 RADEUC=0 "RTN","RASTREQN",105,0) .. Q "RTN","RASTREQN",106,0) . Q "RTN","RASTREQN",107,0) Q "RTN","RASTREQN",108,0) TRAN(X) ; Translate field name to a shorter length. "RTN","RASTREQN",109,0) Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: " "RTN","RASTREQN",110,0) Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: " "RTN","RASTREQN",111,0) Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: " "RTN","RASTREQN",112,0) Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: " "RTN","RASTREQN",113,0) Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: " "RTN","RASTREQN",114,0) Q:X=15 "Form: " "RTN","RASTREQN",115,0) VALDOS(RALOW,RAHI,X,RABACKTO,RAGOTO,RALASTAG,RAWARN) ;validate drawn/dose "RTN","RASTREQN",116,0) ; Called from [RA STATUS CHANGE] and [RA EXAM EDIT] input templates. "RTN","RASTREQN",117,0) ; Validate the value for either : "RTN","RASTREQN",118,0) ; ACTIVITY DRAWN (fld 4, DD: 70.21) "RTN","RASTREQN",119,0) ; DOSE (fld 7, DD: 70.21) "RTN","RASTREQN",120,0) ; If there are limits on the Dosage, validate. "RTN","RASTREQN",121,0) ; If validate fails, ask user if the invalid value is to be accepted. "RTN","RASTREQN",122,0) ; If yes, proceed. "RTN","RASTREQN",123,0) ; If no, re-ask DOSE. "RTN","RASTREQN",124,0) ; Input: RAHI = Upper limit on dosage "RTN","RASTREQN",125,0) ; RALOW = Lower limit on dosage "RTN","RASTREQN",126,0) ; X = Value user input "RTN","RASTREQN",127,0) ; RABACKTO = Previous Line tag to loop back to if need re-ask "RTN","RASTREQN",128,0) ; RAGOTO = Default linetag to proceed to if within range "RTN","RASTREQN",129,0) ; RALASTAG = Last linetag in this edit template if early out "RTN","RASTREQN",130,0) ; RAWARN = display/not the warning msg -- 0=no, 1=yes "RTN","RASTREQN",131,0) ; "RTN","RASTREQN",132,0) ; Output: RAY = linetag to proceed to after exiting this check "RTN","RASTREQN",133,0) ; "RTN","RASTREQN",134,0) N RAY,RAYN S RAY="" I X']"" S RAY=RAGOTO G KVAL "RTN","RASTREQN",135,0) S:RALOW=""&(RAHI="") RAY=RAGOTO "RTN","RASTREQN",136,0) S:RALOW]""&(RAHI="")&(X'RAHI) RAY=RAGOTO "RTN","RASTREQN",138,0) S:RALOW]""&(RAHI]"")&(X'RAHI) RAY=RAGOTO "RTN","RASTREQN",139,0) I RAY="" D "RTN","RASTREQN",140,0) . F D Q:RAY]"" "RTN","RASTREQN",141,0) .. I $O(^RA(79,RAMDIV,"RWARN",0)) D:RAWARN "RTN","RASTREQN",142,0) ... N I S I=0 "RTN","RASTREQN",143,0) ... F S I=$O(^RA(79,RAMDIV,"RWARN",I)) Q:I'>0 W !,$G(^(I,0)) "RTN","RASTREQN",144,0) ... Q "RTN","RASTREQN",145,0) .. E D:RAWARN "RTN","RASTREQN",146,0) ... W !,"This dose requires a written, dated and signed directive by" "RTN","RASTREQN",147,0) ... W !,"a physician." "RTN","RASTREQN",148,0) ... Q "RTN","RASTREQN",149,0) .. W !!?3,"Are you sure (Y/N)?: N//" R RAYN:DTIME "RTN","RASTREQN",150,0) .. I '$T!(RAYN["^") S RAY=RALASTAG Q "RTN","RASTREQN",151,0) .. S RAYN=$S(RAYN']"":"N",1:$$UP^XLFSTR($E(RAYN))) "RTN","RASTREQN",152,0) .. S RAY=$S(RAYN="N":RABACKTO,RAYN="Y":RAGOTO,1:"") "RTN","RASTREQN",153,0) .. I RAY="" W !!?3,"Enter 'Yes' if this value is acceptable, or 'No' if this field is to be",!?3,"re-edited.",$C(7) "RTN","RASTREQN",154,0) .. Q "RTN","RASTREQN",155,0) . Q "RTN","RASTREQN",156,0) KVAL K RABACKTO,RAGOTO,RALASTAG,RAWARN "RTN","RASTREQN",157,0) Q RAY "VER") 8.0^22 **END** **END**