Released RA*5*132 SEQ #126 Extracted from mail message **KIDS**:RA*5.0*132^ **INSTALL NAME** RA*5.0*132 "BLD",10201,0) RA*5.0*132^RADIOLOGY/NUCLEAR MEDICINE^0^3180119^y "BLD",10201,1,0) ^^1^1^3170427^ "BLD",10201,1,1,0) This adds height and weight to Radiology exam registration demograhics. "BLD",10201,4,0) ^9.64PA^^ "BLD",10201,6.3) 12 "BLD",10201,"KRN",0) ^9.67PA^779.2^20 "BLD",10201,"KRN",.4,0) .4 "BLD",10201,"KRN",.401,0) .401 "BLD",10201,"KRN",.402,0) .402 "BLD",10201,"KRN",.403,0) .403 "BLD",10201,"KRN",.5,0) .5 "BLD",10201,"KRN",.84,0) .84 "BLD",10201,"KRN",3.6,0) 3.6 "BLD",10201,"KRN",3.8,0) 3.8 "BLD",10201,"KRN",9.2,0) 9.2 "BLD",10201,"KRN",9.8,0) 9.8 "BLD",10201,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",10201,"KRN",9.8,"NM",1,0) RADEM2^^0^B8852959 "BLD",10201,"KRN",9.8,"NM",2,0) RAORD5^^0^B32521230 "BLD",10201,"KRN",9.8,"NM",3,0) RAORD6^^0^B62955625 "BLD",10201,"KRN",9.8,"NM",4,0) RAORDS^^0^B46087861 "BLD",10201,"KRN",9.8,"NM","B","RADEM2",1) "BLD",10201,"KRN",9.8,"NM","B","RAORD5",2) "BLD",10201,"KRN",9.8,"NM","B","RAORD6",3) "BLD",10201,"KRN",9.8,"NM","B","RAORDS",4) "BLD",10201,"KRN",19,0) 19 "BLD",10201,"KRN",19,"NM",0) ^9.68A^^ "BLD",10201,"KRN",19.1,0) 19.1 "BLD",10201,"KRN",101,0) 101 "BLD",10201,"KRN",409.61,0) 409.61 "BLD",10201,"KRN",771,0) 771 "BLD",10201,"KRN",779.2,0) 779.2 "BLD",10201,"KRN",870,0) 870 "BLD",10201,"KRN",8989.51,0) 8989.51 "BLD",10201,"KRN",8989.52,0) 8989.52 "BLD",10201,"KRN",8994,0) 8994 "BLD",10201,"KRN","B",.4,.4) "BLD",10201,"KRN","B",.401,.401) "BLD",10201,"KRN","B",.402,.402) "BLD",10201,"KRN","B",.403,.403) "BLD",10201,"KRN","B",.5,.5) "BLD",10201,"KRN","B",.84,.84) "BLD",10201,"KRN","B",3.6,3.6) "BLD",10201,"KRN","B",3.8,3.8) "BLD",10201,"KRN","B",9.2,9.2) "BLD",10201,"KRN","B",9.8,9.8) "BLD",10201,"KRN","B",19,19) "BLD",10201,"KRN","B",19.1,19.1) "BLD",10201,"KRN","B",101,101) "BLD",10201,"KRN","B",409.61,409.61) "BLD",10201,"KRN","B",771,771) "BLD",10201,"KRN","B",779.2,779.2) "BLD",10201,"KRN","B",870,870) "BLD",10201,"KRN","B",8989.51,8989.51) "BLD",10201,"KRN","B",8989.52,8989.52) "BLD",10201,"KRN","B",8994,8994) "BLD",10201,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10201,"QUES",0) ^9.62^^ "BLD",10201,"REQB",0) ^9.611^^ "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^2980805^1 "PKG",31,22,1,"PAH",1,0) 132^3180119 "PKG",31,22,1,"PAH",1,1,0) ^^1^1^3180119 "PKG",31,22,1,"PAH",1,1,1,0) This adds height and weight to Radiology exam registration demograhics. "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") NO "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") NO "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") NO "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") 4 "RTN","RADEM2") 0^1^B8852959^B6794496 "RTN","RADEM2",1,0) RADEM2 ;HISC/CAH,FPT,GJC-Display Patient Demographics (short) ;10/20/94 09:18 "RTN","RADEM2",2,0) ;;5.0;Radiology/Nuclear Medicine;**31,132**;Mar 16, 1998;Build 12 "RTN","RADEM2",3,0) ;ICR# Type Description "RTN","RADEM2",4,0) ;----- ---- ------------------------------------- "RTN","RADEM2",5,0) ;1120 SUP EN6^GMRVUTL "RTN","RADEM2",6,0) ; "RTN","RADEM2",7,0) PAT Q:'$D(^DPT(RADFN,0)) S Y=^(0),RANME=$P(Y,"^"),RASEX=$P(Y,"^",2),RASSN=$$SSN^RAUTL,RADOB=$P(Y,"^",3),X1=DT,X2=RADOB D ^%DTC S RAGE=X\365.25 "RTN","RADEM2",8,0) S:$E(DT,4,7)=$E(RADOB,4,7) RAGE=RAGE+1 ; today is birthday "RTN","RADEM2",9,0) S Y=RADOB D D^RAUTL S RADOB=Y "RTN","RADEM2",10,0) N RAVETELI S RAVETELI=$$VETELI(RADFN) "RTN","RADEM2",11,0) S RAVET=$P(RAVETELI,"^"),RAELIG=$P(RAVETELI,"^",2) "RTN","RADEM2",12,0) I $D(^DPT(RADFN,.1)),^(.1)]"" D ^RASERV "RTN","RADEM2",13,0) DIS W @IOF,!," *********** Patient Demographics ***********",! "RTN","RADEM2",14,0) W !?2,"Name : ",$E(RANME,1,20) W:$D(RAWARD) ?37,"Currently is an inpatient." "RTN","RADEM2",15,0) W !?2,"Pt ID : ",RASSN W:$D(RAWARD) ?39,"Ward/Service: ",$E(RAWARD_"/"_RASER,1,25) "RTN","RADEM2",16,0) W !?2,"Date of Birth: ",RADOB," (",RAGE,")" W:$D(RABED) ?39,"Bedsection : ",RABED "RTN","RADEM2",17,0) W !?2,"Veteran : ",RAVET,?39,"Eligibility : ",$E(RAELIG,1,25) "RTN","RADEM2",18,0) W !?2,"Sex : ",$S(RASEX="M":"MALE",RASEX="F":"FEMALE",1:"Unknown") I $D(^RADPT(RADFN,1)) W !?2,"Narrative : ",^(1) "RTN","RADEM2",19,0) ;RTW Add height and weight *** BEGIN *** "RTN","RADEM2",20,0) D ; "RTN","RADEM2",21,0) .N RAHDVITL,RAHDX,DFN,GMRVSTR,X,Y "RTN","RADEM2",22,0) .F RAHDVITL="HT","WT" D "RTN","RADEM2",23,0) .. S DFN=RADFN,GMRVSTR=RAHDVITL "RTN","RADEM2",24,0) .. D EN6^GMRVUTL S RAHDX=$G(X) "RTN","RADEM2",25,0) .. W !?2,$E(RAHDVITL),"eight : ",$P(RAHDX,U,8) "RTN","RADEM2",26,0) .. I $P(RAHDX,U,8)]"" W $S(RAHDVITL="HT":"""",RAHDVITL="WT":" lbs",1:"") "RTN","RADEM2",27,0) .. S Y=$P(RAHDX,U,1) I Y>0 D D^RAUTL W " on ",Y "RTN","RADEM2",28,0) .. Q "RTN","RADEM2",29,0) . Q "RTN","RADEM2",30,0) ;RTW Add height and weight *** END *** "RTN","RADEM2",31,0) W !?2,"Other Allergies:",!?7,"'V' denotes verified allergy 'N' denotes non-verified allergy",! "RTN","RADEM2",32,0) S DFN=RADFN D ALLERGY^RADEM I '$D(GMRAL) W !?20,"** No allergies on file. **" G ALER "RTN","RADEM2",33,0) F I=1:1 Q:'$D(PI(I)) W:I#2 !?2,PI(I) W:I#2=0 ?40,PI(I) "RTN","RADEM2",34,0) ; "RTN","RADEM2",35,0) ALER ; "RTN","RADEM2",36,0) S RAPOP=0 I $D(^DPT(RADFN,.35)),$P(^(.35),"^") W !!?2,$C(7),"**** Patient has died ****",!!,"Do you want to continue? NO// " R X:DTIME S:"Nn"[X RAPOP=1 "RTN","RADEM2",37,0) Q K RAWD,PI,RADOB,RAELIG,RAGE,RASSN,RAVET,I,VAIN,VAERR,X,Y Q:RAPOP S RACONT="" G ^RADEM1 "RTN","RADEM2",38,0) ; "RTN","RADEM2",39,0) RADFN S DIC(0)="AEZMQ" D ^RADPA Q:Y<0 S RADFN=+Y G PAT "RTN","RADEM2",40,0) ; "RTN","RADEM2",41,0) VETELI(DFN) ; Is this patient a veteran? Does this patient have a "RTN","RADEM2",42,0) ; primary eligibility code? "RTN","RADEM2",43,0) ; RAELI=Primary Eligibility code <-> RAVET=Veteran (Yes/No) "RTN","RADEM2",44,0) N RAELI,RAVET Q:DFN'=+DFN "Unknown^Unknown" "RTN","RADEM2",45,0) I 'DFN!('$D(^DPT(DFN,0))#2) S (RAELI,RAVET)="Unknown" "RTN","RADEM2",46,0) E D "RTN","RADEM2",47,0) . K VAEL,VAERR D ELIG^VADPT "RTN","RADEM2",48,0) . S RAELI=$P($G(VAEL(1)),"^",2) "RTN","RADEM2",49,0) . S RAELI=$S(RAELI]"":RAELI,1:"Unknown") "RTN","RADEM2",50,0) . S RAVET=+$G(VAEL(4)) "RTN","RADEM2",51,0) . S RAVET=$S(RAVET:"Yes",'RAVET:"No",1:"Unknown") "RTN","RADEM2",52,0) . K VAEL,VAERR "RTN","RADEM2",53,0) . Q "RTN","RADEM2",54,0) Q RAVET_"^"_RAELI "RTN","RAORD5") 0^2^B32521230^B30588485 "RTN","RAORD5",1,0) RAORD5 ;HISC/CAH,FPT,GJC AISC/RMO-Print A Request ;8/4/97 14:47 "RTN","RAORD5",2,0) ;;5.0;Radiology/Nuclear Medicine;**8,10,15,31,45,75,123,132**;Mar 16, 1998;Build 12 "RTN","RAORD5",3,0) ; Input: RADFN= Internal Number to Rad/Nuc Med Patient File #70 "RTN","RAORD5",4,0) ; RAOIFN= Internal Number to Rad/Nuc Med Orders File #75.1 "RTN","RAORD5",5,0) ; RAX= Null (Used to check for an '^') "RTN","RAORD5",6,0) ; RAPGE= 0 (Used as a page counter) "RTN","RAORD5",7,0) ; "RTN","RAORD5",8,0) ; Supported IA #1120 reference to EN6^GMRVUTL 5-P123,5-132 "RTN","RAORD5",9,0) ; "RTN","RAORD5",10,0) ; 1-p75 10/12/2006 GJC RA*5*75 Remedy 162508 Modify Patient AGE calc "RTN","RAORD5",11,0) ; 2-p75 10/12/2006 GJC RA*5*75 set REASON FOR STUDY to a local variable "RTN","RAORD5",12,0) ; 5-P123 6/23/2015 MJT RA*5*123 NSR 20140507 print weight & date taken in Radiology requests "RTN","RAORD5",13,0) ; 5-P132 11/1/2017 RTW RA*5*123 NSR 20160706 print height & date taken in Radiology requests "RTN","RAORD5",14,0) ; "RTN","RAORD5",15,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","RAORD5",16,0) G Q:'$D(^DPT(RADFN,0)) S RADPT0=^(0) G Q:'$D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0) "RTN","RAORD5",17,0) K ^UTILITY($J,"W"),^(1) S RAOSTSYM="dc^c^h^^p^^^s",$P(RALNE,"-",79)="",$P(RALNE1,"=",79)="",DIWL=5,DIWR=75,DIWF="WC75" "RTN","RAORD5",18,0) S RA("NME")=$P(RADPT0,"^"),RA("SEX")=$P(RADPT0,"^",2),RA("DOB")=$P(RADPT0,"^",3),RASSN=$$SSN^RAUTL "RTN","RAORD5",19,0) S RA("AGE")=($$FMDIFF^XLFDT($P(RAORD0,U,16),RA("DOB")))\365.25 ;1-p75 "RTN","RAORD5",20,0) S RA("STY_REA")=$P($G(^RAO(75.1,RAOIFN,.1)),U) ;2-p75 "RTN","RAORD5",21,0) S RA("PRC NODE")=$G(^RAMIS(71,+$P(RAORD0,U,2),0)) "RTN","RAORD5",22,0) S RA("PRC")=$E($P(RA("PRC NODE"),U),1,36) "RTN","RAORD5",23,0) S RA("PRC")=$S(RA("PRC")]"":RA("PRC"),1:"UNKNOWN") "RTN","RAORD5",24,0) S RA("PRCTY")=$P(RA("PRC NODE"),U,6) "RTN","RAORD5",25,0) S RA("PRCTY")=$$XTERNAL^RAUTL5(RA("PRCTY"),$P($G(^DD(71,6,0)),U,2)) "RTN","RAORD5",26,0) S RA("PRCTY")=$E(RA("PRCTY"))_$$LOW^XLFSTR($E(RA("PRCTY"),2,99)) "RTN","RAORD5",27,0) S RA("CPT")=+$P(RA("PRC NODE"),U,9) "RTN","RAORD5",28,0) S RA("CPT")=$P($$NAMCODE^RACPTMSC(RA("CPT"),DT),U) "RTN","RAORD5",29,0) S RA("PRCIT")=+$P(RA("PRC NODE"),U,12) "RTN","RAORD5",30,0) S RA("PRCIT")=$P($G(^RA(79.2,RA("PRCIT"),0)),U,3) "RTN","RAORD5",31,0) S RA("CNCAT")="("_RA("PRCIT")_" "_RA("PRCTY")_" "_RA("CPT")_")" "RTN","RAORD5",32,0) S RA("PRC INFO")="",$E(RA("PRC INFO"),1,36)=RA("PRC") "RTN","RAORD5",33,0) S $E(RA("PRC INFO"),38,60)=RA("CNCAT") K RA("CNCAT") "RTN","RAORD5",34,0) S RA("PRC MSG")=$S(+$O(^RAMIS(71,+$P(RAORD0,"^",2),3,0))>0:1,1:0) "RTN","RAORD5",35,0) S RA("OUG")=$P($P(^DD(75.1,6,0),$P(RAORD0,"^",6)_":",2),";") "RTN","RAORD5",36,0) K RA("MOD") F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RA("MOD")=$S('$D(RA("MOD")):$P(^(0),"^"),1:RA("MOD")_", "_$P(^(0),"^")) S:$P($G(^(0)),U,2)="p" RA("PORTABLE")="" "RTN","RAORD5",37,0) S RA("OST")=$$GET1^DIQ(75.1,RAOIFN_",",5)_$S($P(RAOSTSYM,"^",$P(RAORD0,"^",5))="":"",1:" ("_$P(RAOSTSYM,"^",$P(RAORD0,"^",5))_")") "RTN","RAORD5",38,0) S RA("PHY")=$S($D(^VA(200,+$P(RAORD0,"^",14),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","RAORD5",39,0) ; Requesting Physician Phone info "RTN","RAORD5",40,0) D:RA("PHY")'="UNKNOWN" PHONE("R",+$P(RAORD0,"^",14)) "RTN","RAORD5",41,0) ; Get current primary and attending physicians "RTN","RAORD5",42,0) S DFN=RADFN,VA200=1 D IN5^VADPT K VA200 S:'$D(VAIP(18)) VAIP(18)="" "RTN","RAORD5",43,0) ; *** NSR 20140507 Start Mod to print weight & date taken in Radiology requests 5-P123 *** "RTN","RAORD5",44,0) S DFN=RADFN,GMRVSTR="WT" "RTN","RAORD5",45,0) D EN6^GMRVUTL "RTN","RAORD5",46,0) S RA("WT")=$P(X,U,8) "RTN","RAORD5",47,0) ;RTW BEGIN RA*5.0*132 ADD HEIGHT "RTN","RAORD5",48,0) S DFN=RADFN,GMRVSTR="HT" "RTN","RAORD5",49,0) D EN6^GMRVUTL S RAHDX=$G(X) "RTN","RAORD5",50,0) S Y=$P(RAHDX,U,1) I Y>0 D DD^%DT S RA("HTDT")=Y "RTN","RAORD5",51,0) S RA("HT")=$P(RAHDX,U,8) "RTN","RAORD5",52,0) S Y=$P(X,U) D DD^%DT S RA("WTDT")=Y "RTN","RAORD5",53,0) ;RTW END RA*5.0*132 ADD HEIGHT "RTN","RAORD5",54,0) ; actual print code located in RAORD6 "RTN","RAORD5",55,0) ; *** NSR 20140507 End Mod to print weight & date taken in Radiology requests *** "RTN","RAORD5",56,0) I '+$G(VAIP(7)) D "RTN","RAORD5",57,0) . ; If the Primary Physician is not found (based on inpatient episode) "RTN","RAORD5",58,0) . ; find the current Primary Care Practitioner (See patch SD*5.3*30) "RTN","RAORD5",59,0) . ; VAIP(7) is null at this point. VAIP(7) will exit this DO block "RTN","RAORD5",60,0) . ; set to the Primary Care Practitioner or null. "RTN","RAORD5",61,0) . N X S X="SDUTL3" X ^%ZOSF("TEST") "RTN","RAORD5",62,0) . S:$T VAIP(7)=$$OUTPTPR^SDUTL3(RADFN) "RTN","RAORD5",63,0) . Q "RTN","RAORD5",64,0) ; Get Current Primary and Attending Physician Phone info "RTN","RAORD5",65,0) S RA("ATTEN")=$S($P(VAIP(18),"^",2)]"":$P(VAIP(18),"^",2),1:"UNKNOWN") "RTN","RAORD5",66,0) D:RA("ATTEN")'="UNKNOWN" PHONE("A",+$G(VAIP(18))) "RTN","RAORD5",67,0) S RA("PRIM")=$S($P(VAIP(7),"^",2)]"":$P(VAIP(7),"^",2),1:"UNKNOWN") "RTN","RAORD5",68,0) D:RA("PRIM")'="UNKNOWN" PHONE("P",+$G(VAIP(7))) "RTN","RAORD5",69,0) ; Requesting location, room-bed "RTN","RAORD5",70,0) S RA("HLC")=$S($D(^SC(+$P(RAORD0,"^",22),0)):$P(^(0),"^"),1:"UNKNOWN"),RA("HPH")=$S($D(^SC(+$P(RAORD0,"^",22),99)):$P(^(99),"^"),1:"") I VAIP(1) S RA("ROOM-BED")=$S(+VAIP(6):$P(VAIP(6),"^",2),1:"") "RTN","RAORD5",71,0) ; Get primary and attending phys as of order date and their phone, etc. "RTN","RAORD5",72,0) K RA("ODT") S Y=$P(RAORD0,"^",16) I Y S:$P(Y,".",2) Y=$P(Y,".")_"."_$$NOSECNDS^RAORD3($P(Y,".",2)) S RA("ODT")=$$FMTE^XLFDT(Y,"1P") "RTN","RAORD5",73,0) K VAIP S DFN=RADFN,VAIP("D")=+$P(RAORD0,"^",16),VA200=1 D:VAIP("D") IN5^VADPT K VA200 "RTN","RAORD5",74,0) S RA("OATTEN")=$S($P($G(VAIP(18)),"^",2)]"":$P(VAIP(18),"^",2),1:"UNKNOWN") "RTN","RAORD5",75,0) D:RA("OATTEN")'="UNKNOWN" PHONE("OA",+$G(VAIP(18))) "RTN","RAORD5",76,0) S RA("OPRIM")=$S($P($G(VAIP(7)),"^",2)]"":$P(VAIP(7),"^",2),1:"UNKNOWN") "RTN","RAORD5",77,0) D:RA("OPRIM")'="UNKNOWN" PHONE("OP",+$G(VAIP(7))) "RTN","RAORD5",78,0) ; Get other order info (orderer, transport mode, etc.) "RTN","RAORD5",79,0) S RA("USR")=$S($D(^VA(200,+$P(RAORD0,"^",15),0)):$P(^(0),"^"),1:"UNKNOWN"),RA("TRAN")=$S($P(RAORD0,"^",19)']"":"UNKNOWN",1:$P($P(^DD(75.1,19,0),$P(RAORD0,"^",19)_":",2),";")) S:$P(RAORD0,"^",19)="p" RA("PORTABLE")="" "RTN","RAORD5",80,0) K RA("ST"),^TMP($J,"RA DIFF PRC") "RTN","RAORD5",81,0) ;determine if ordered procedure has CM assoc.; return null if none "RTN","RAORD5",82,0) S RACMFLG("O")=$$CMEDIA^RAO7UTL(+$P(RAORD0,U,2),$P(RA("PRC NODE"),U,6)) "RTN","RAORD5",83,0) ; If appropriate, determine exam status and descendant exams "RTN","RAORD5",84,0) I $D(^RADPT("AO",RAOIFN,RADFN)) D DPRC^RAORD2(RAOIFN,RADFN) "RTN","RAORD5",85,0) S RADIV(0)=$G(^SC(+$P(RAORD0,"^",22),0)) "RTN","RAORD5",86,0) S RADIV=+$$SITE^VASITE(DT,+$P(RADIV(0),"^",15)) S:RADIV<0 RADIV=0 "RTN","RAORD5",87,0) S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0))) "RTN","RAORD5",88,0) S RADIVPAR=$S($D(^RA(79,+RADIV,.1)):^(.1),1:"") "RTN","RAORD5",89,0) K RA("RDT") S Y=$P(RAORD0,"^",21) I Y S:$P(Y,".",2) Y=$P(Y,".")_"."_$$NOSECNDS^RAORD3($P(Y,".",2)) S RA("RDT")=$$FMTE^XLFDT(Y,"1P") "RTN","RAORD5",90,0) K RA("PDT") S Y=$P(RAORD0,"^",12) I Y S:$P(Y,".",2) Y=$P(Y,".")_"."_$$NOSECNDS^RAORD3($P(Y,".",2)) S RA("PDT")=$$FMTE^XLFDT(Y,"1P") "RTN","RAORD5",91,0) K RA("VDT") S Y=$P(RAORD0,"^",17) I Y S:$P(Y,".",2) Y=$P(Y,".")_"."_$$NOSECNDS^RAORD3($P(Y,".",2)) S RA("VDT")=$$FMTE^XLFDT(Y,"1P") "RTN","RAORD5",92,0) K RA("SDT") S Y=$P(RAORD0,"^",23) I Y S:$P(Y,".",2) Y=$P(Y,".")_"."_$$NOSECNDS^RAORD3($P(Y,".",2)) S RA("SDT")=$$FMTE^XLFDT(Y,"1P") "RTN","RAORD5",93,0) S RA("ILC")=$S('$P(RAORD0,"^",20):"UNKNOWN",'$D(^RA(79.1,+$P(RAORD0,"^",20),0)):"UNKNOWN",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","RAORD5",94,0) D ^RAORD6 "RTN","RAORD5",95,0) ; "RTN","RAORD5",96,0) Q K DIWF,DIWL,DIWR,I,RA,RABARC,RABARC0,RABARC1,RADIV,RADIVPAR,RADPT0,RALNE,RALNE1,RAORD0,RAOSTSYM,RATAB,RAV,RASSN,RAXX,VA200,VAERR,VAIP,X,X1,X2,X3,Y,ZZ "RTN","RAORD5",97,0) K RACMFLG,RALOC,^TMP($J,"RA DIFF PRC") "RTN","RAORD5",98,0) Q "RTN","RAORD5",99,0) PHONE(X,Y) ; Setup phone information for Resident Physicians, Attending "RTN","RAORD5",100,0) ; Physicians, and Primary Physicians. "RTN","RAORD5",101,0) ; 'X' -> $S('A':'Attending','OA':'Old Attending','OP':'Old Primary', "RTN","RAORD5",102,0) ; ,'P':'Primary','R':'Resident') "RTN","RAORD5",103,0) ; 'Y' -> ien for file 200 "RTN","RAORD5",104,0) ; RA(X_"PHON")=Phone node <> RA(X_"OPHO")=Office phone "RTN","RAORD5",105,0) ; RA(X_"VPGR")=Voice pager <> RA(X_"DPGR")=Digital pager "RTN","RAORD5",106,0) ; RA(X_"PHOINFO")=office phone/voice pager/digital pager "RTN","RAORD5",107,0) S RA(X_"PHON")=$G(^VA(200,+Y,.13)) "RTN","RAORD5",108,0) S RA(X_"OPHO")=$P(RA(X_"PHON"),U,2),RA(X_"VPGR")=$P(RA(X_"PHON"),U,7) "RTN","RAORD5",109,0) S RA(X_"DPGR")=$P(RA(X_"PHON"),U,8) "RTN","RAORD5",110,0) S RA(X_"PHOINFO")=RA(X_"OPHO")_" / "_RA(X_"VPGR")_" / "_RA(X_"DPGR") "RTN","RAORD5",111,0) S:RA(X_"PHOINFO")=" / / " RA(X_"PHOINFO")="Unknown" "RTN","RAORD5",112,0) Q "RTN","RAORD6") 0^3^B62955625^B60840367 "RTN","RAORD6",1,0) RAORD6 ;HISC/CAH - AISC/RMO-Print A Request Cont. ;05/20/09 07:28 "RTN","RAORD6",2,0) ;;5.0;Radiology/Nuclear Medicine;**5,10,15,18,27,45,41,75,85,99,123,132**;Mar 16, 1998;Build 12 "RTN","RAORD6",3,0) ; 3-p75 10/12/2006 GJC RA*5*75 print Reason for Study "RTN","RAORD6",4,0) ; 4-p75 10/12/2006 KAM RA*5*75 display the request print date in the header "RTN","RAORD6",5,0) ; 5-p75 10/12/2006 KAM RA*5*75 update header "Age" to "Age at req" "RTN","RAORD6",6,0) ; 6-p85 06/20/2007 KAM RA*5*85 Reason for Study/Bar Code print issue "RTN","RAORD6",7,0) ; Remedy Call - 193859 "RTN","RAORD6",8,0) ; 5-P123 6/23/2015 MJT RA*5*123 NSR 20140507 print weight & date taken in Radiology requests "RTN","RAORD6",9,0) ; 5-P132 11/1/2017 RTW RA*5*123 NSR 20160706 print height & date taken in Radiology requests "RTN","RAORD6",10,0) ; "RTN","RAORD6",11,0) ;Supported IA #10104 reference to ^XLFSTR "RTN","RAORD6",12,0) ;Supported IA #10060 reference to ^VA(200 "RTN","RAORD6",13,0) D HD Q:RAX["^" "RTN","RAORD6",14,0) I $$PTSEX^RAUTL8(RADFN)="F" D ;display pregnancy status for females ptch 45 "RTN","RAORD6",15,0) .W !,"Pregnant at time of order entry: ",?22,$S($P(RAORD0,"^",13)="y":"YES",$P(RAORD0,"^",13)="n":"NO",1:"UNKNOWN") "RTN","RAORD6",16,0) .Q:'$D(RAOIFN) "RTN","RAORD6",17,0) .Q:'$D(^RADPT("AO",$G(RAOIFN),RADFN)) "RTN","RAORD6",18,0) .N RAINVDT,RA5 "RTN","RAORD6",19,0) .S RAINVDT=$O(^RADPT("AO",RAOIFN,RADFN,0)) "RTN","RAORD6",20,0) .Q:'$G(RAINVDT) "RTN","RAORD6",21,0) .S RA5=$O(^RADPT("AO",RAOIFN,RADFN,RAINVDT,0)) "RTN","RAORD6",22,0) .Q:'$G(RA5) "RTN","RAORD6",23,0) .N R3,RAPCOMM S R3=$G(^RADPT(RADFN,"DT",$G(RAINVDT),"P",$G(RA5),0)) "RTN","RAORD6",24,0) .S RAPCOMM=$G(^RADPT(RADFN,"DT",+$G(RAINVDT),"P",+$G(RA5),"PCOMM")) "RTN","RAORD6",25,0) .W:$P(R3,U,32)'="" !,"Pregnancy Screen: ",$S($P(R3,"^",32)="y":"Patient answered yes",$P(R3,"^",32)="n":"Patient answered no",$P(R3,"^",32)="u":"Patient is unable to answer or is unsure",1:"") "RTN","RAORD6",26,0) .W:$P(R3,U,32)'="n"&$L(RAPCOMM) !,"Pregnancy Screen Comment: ",RAPCOMM "RTN","RAORD6",27,0) .Q "RTN","RAORD6",28,0) W:$P(RAORD0,"^",24)="y" !!?12,"*** Universal Isolation Precautions ***" "RTN","RAORD6",29,0) W:$D(RA("VDT")) !!?8,"** Note Request Associated with Visit on ",RA("VDT")," **" "RTN","RAORD6",30,0) W !!,"Requested:",?18,RA("PRC INFO") "RTN","RAORD6",31,0) I $D(^TMP($J,"RA DIFF PRC")),('$D(RAFOERR)),('$D(RAOPT("REG"))),('$D(RAOPT("ORDEREXAM"))),('$D(RAOPT("ADDEXAM"))) D Q:RAX["^" "RTN","RAORD6",32,0) . ; don't print registered procedure info (CPT, Proc Type, Imaging "RTN","RAORD6",33,0) . ; Type) if entering through 'Request An Exam', 'Register Patient "RTN","RAORD6",34,0) . ; for Exams' or 'Add Exams To Last Visit'. Don't print if ordered "RTN","RAORD6",35,0) . ; through ANY version of OE/RR. If ordered through OE/RR, RAFOERR "RTN","RAORD6",36,0) . ; will be defined. (Set in RAORD1 & RAO7RO) "RTN","RAORD6",37,0) . N RAT,RA18NLIN S RAT="",RA18NLIN=0 W !,"Registered:" "RTN","RAORD6",38,0) . F S RAT=$O(^TMP($J,"RA DIFF PRC",RAT)) Q:RAT="" D Q:RAX["^" "RTN","RAORD6",39,0) .. D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",40,0) .. W:RA18NLIN ! W ?12,RAT "RTN","RAORD6",41,0) .. S RA18NLIN=1 "RTN","RAORD6",42,0) .. Q "RTN","RAORD6",43,0) . Q "RTN","RAORD6",44,0) I $G(RACMFLG("O"))'="" W !?12,"** The requested procedure has contrast media assigned **" "RTN","RAORD6",45,0) I $G(RACMFLG("R"))'="" W !?12,"** A registered procedure uses contrast media **" "RTN","RAORD6",46,0) W:$D(RA("MOD")) !,"Procedure Modifiers:",?22,RA("MOD") "RTN","RAORD6",47,0) I RA("PRC MSG") D Q:RAX["^" "RTN","RAORD6",48,0) . N A,B,C,X S (A,C)=0 W !,"Procedure Message: ",! "RTN","RAORD6",49,0) . F S A=$O(^RAMIS(71,+$P(RAORD0,"^",2),3,A)) Q:A'>0!(RAX["^") D "RTN","RAORD6",50,0) .. S B=+$G(^RAMIS(71,+$P(RAORD0,"^",2),3,A,0)) "RTN","RAORD6",51,0) .. S X=$G(^RAMIS(71.4,B,0)) "RTN","RAORD6",52,0) .. W:'C ?3,"-" W:C !?3,"-" "RTN","RAORD6",53,0) .. D OUTTEXT^RAUTL9(X,"",5,80,4,"","!") "RTN","RAORD6",54,0) .. D HD:($Y+10)>IOSL S C=C+1 ; 5-P123 "RTN","RAORD6",55,0) .. Q "RTN","RAORD6",56,0) . Q "RTN","RAORD6",57,0) W !,"Request Status:",?22,$E(RA("OST"),1,24) "RTN","RAORD6",58,0) I $P(RAORD0,"^",5)=1!($P(RAORD0,"^",5)=3) D Q:RAX["^" "RTN","RAORD6",59,0) . W !,"Reason ",$S($P(RAORD0,"^",5)=1:"Cancelled",1:"Held"),":" "RTN","RAORD6",60,0) . W ?22,$S($D(^RA(75.2,+$P(RAORD0,"^",10),0)):$E($P(^(0),"^"),1,50),$P(RAORD0,"^",27)]"":$E($P(RAORD0,"^",27),1,50),1:"UNKNOWN") "RTN","RAORD6",61,0) . D HD:($Y+10)>IOSL Q:RAX["X" ; 5-P123 "RTN","RAORD6",62,0) . I $D(^RAO(75.1,RAOIFN,1)) D Q:RAX["^" "RTN","RAORD6",63,0) .. N X,I,RAXX "RTN","RAORD6",64,0) .. K ^UTILITY($J,"W") "RTN","RAORD6",65,0) .. W !,"Hold Description:",! "RTN","RAORD6",66,0) .. S I=0 F S I=$O(^RAO(75.1,RAOIFN,1,I)) Q:'I S (RAXX,X)=^(I,0) D HD:($Y+10)>IOSL Q:RAX["^" S X=RAXX D ^DIWP ; 5-P123 "RTN","RAORD6",67,0) .. Q:RAX["^" "RTN","RAORD6",68,0) .. D HD:($Y+10)>IOSL Q:RAX["X" ; 5-P123 "RTN","RAORD6",69,0) .. D ^DIWW:$D(RAXX) "RTN","RAORD6",70,0) .. D HD:($Y+10)>IOSL Q:RAX["X" ; 5-P123 "RTN","RAORD6",71,0) . I $P(RAORD0,"^",5)=1 D "RTN","RAORD6",72,0) .. W !!,?(IOM-(IOM/2+15)),"*********************",!,?(IOM-(IOM/2+15)),"* C A N C E L L E D *",!,?(IOM-(IOM/2+15)),"*********************" "RTN","RAORD6",73,0) W:$P(RAORD0,"^",5)=6&($D(RA("ST"))) !,"Exam Status:",?22,RA("ST") "RTN","RAORD6",74,0) W:$P(RAORD0,"^",5)=8&($D(RA("SDT"))) !,"Exam Scheduled:",?22,RA("SDT") "RTN","RAORD6",75,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",76,0) W !!,"Requester:",?22,$E(RA("PHY"),1,20) "RTN","RAORD6",77,0) W:RA("PHY")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("RPHOINFO")) "RTN","RAORD6",78,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",79,0) W !,"Attend Phy Current:",?22,$E(RA("ATTEN"),1,20) "RTN","RAORD6",80,0) W:RA("ATTEN")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("APHOINFO")) "RTN","RAORD6",81,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",82,0) W !,"Prim Phy Current:",?22,$E(RA("PRIM"),1,20) "RTN","RAORD6",83,0) W:RA("PRIM")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("PPHOINFO")) "RTN","RAORD6",84,0) K RAPASS1,RAPASS2 "RTN","RAORD6",85,0) S RAPASS1=RA("ATTEN"),RAPASS2=RA("OATTEN") "RTN","RAORD6",86,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",87,0) I $$ID^RAORD6(RAPASS1,RAPASS2) D "RTN","RAORD6",88,0) . W !,"Attend Phy At Order:",?22,$E(RA("OATTEN"),1,20) "RTN","RAORD6",89,0) . W:RA("OATTEN")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("OAPHOINFO")) "RTN","RAORD6",90,0) . Q "RTN","RAORD6",91,0) S RAPASS1=RA("PRIM"),RAPASS2=RA("OPRIM") "RTN","RAORD6",92,0) I $$ID^RAORD6(RAPASS1,RAPASS2) D "RTN","RAORD6",93,0) . W !,"Prim Phy At Order:",?22,$E(RA("OPRIM"),1,20) "RTN","RAORD6",94,0) . W:RA("OPRIM")'="UNKNOWN" !?1,"Tel/Page/Dig Page: ",$G(RA("OPPHOINFO")) "RTN","RAORD6",95,0) . Q "RTN","RAORD6",96,0) K RAPASS1,RAPASS2 "RTN","RAORD6",97,0) I +$P(RAORD0,"^",8) D "RTN","RAORD6",98,0) . N RAPPRAD S RAPPRAD=+$P(RAORD0,"^",8) "RTN","RAORD6",99,0) . S:$P($G(^VA(200,RAPPRAD,20)),"^",2)]"" RAPPRAD=$P(^(20),"^",2) "RTN","RAORD6",100,0) . S:RAPPRAD=+RAPPRAD RAPPRAD=$P(^VA(200,RAPPRAD,0),"^") "RTN","RAORD6",101,0) . W !,"Approved by: ",?22,RAPPRAD "RTN","RAORD6",102,0) . Q "RTN","RAORD6",103,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",104,0) W !,"Date/Time Ordered:",?22,$S($D(RA("ODT")):RA("ODT"),1:"")," by ",$E(RA("USR"),1,20) "RTN","RAORD6",105,0) W:$D(RA("RDT")) !,"Date Desired:",?22,RA("RDT") "RTN","RAORD6",106,0) D:$P(RAORD0,"^",5)=1 USERCAN^RAORD3 "RTN","RAORD6",107,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",108,0) W:$D(RA("PDT")) !,"Pre-op Date/Time:",?22,RA("PDT"),!!?26,"**** P R E - O P ****",! "RTN","RAORD6",109,0) BAR ;Print bar-coded SSN on request form if term type has bar code setup "RTN","RAORD6",110,0) I $G(RASSN)'?3N1"-"2N1"-".E G CONT "RTN","RAORD6",111,0) S X3=$E(RASSN,1,3)_$E(RASSN,5,6)_$E(RASSN,8,11) "RTN","RAORD6",112,0) ; 06/20/2007 KAM/BAY RA*5*85 Added 2 line feeds "RTN","RAORD6",113,0) D PSET^%ZISP I IOBARON]"",(IOBAROFF]"") W !!!?49,@IOBARON,X3,@IOBAROFF,! "RTN","RAORD6",114,0) D PKILL^%ZISP "RTN","RAORD6",115,0) ; "RTN","RAORD6",116,0) CONT D HD:($Y+10)>IOSL Q:RAX["^" D ODX^RABWUTL(RAOIFN) ; * Billing Aware * ; 5-P123 "RTN","RAORD6",117,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",118,0) ; 06/20/2007 KAM/BAY RA*5*85 Added line feed to the next line "RTN","RAORD6",119,0) I $L(RA("STY_REA")) W ! D DIWP^RAUTL5(1,68,"Reason for Study: "_RA("STY_REA")) ;3-p75 "RTN","RAORD6",120,0) D HD:($Y+10)>IOSL Q:RAX["^" K ^UTILITY($J,"W"),^(1) W !,"Clinical History:",! K RAXX F RAV=0:0 S RAV=$O(^RAO(75.1,RAOIFN,"H",RAV)) Q:'RAV I $D(^(RAV,0)) S RAXX=^(0) D HD:($Y+10)>IOSL Q:RAX["^" S X=RAXX D ^DIWP ; 5-P123 "RTN","RAORD6",121,0) Q:RAX["^" D HD:($Y+10)>IOSL Q:RAX["^" D ^DIWW:$D(RAXX),HD:($Y+10)>IOSL Q:RAX["^" D WORK ;always print bottom section of form 012601 ; 5-P123 "RTN","RAORD6",122,0) W ! S BOT=IOSL-($Y+4) S:($E(IOST,1,6)="P-BROW"&($D(DDBRZIS))) BOT=5 F BT=1:1:BOT W ! "RTN","RAORD6",123,0) K BOT,BT "RTN","RAORD6",124,0) W !,"VA Form 519a-ADP" "RTN","RAORD6",125,0) Q "RTN","RAORD6",126,0) ; "RTN","RAORD6",127,0) WORK W !,RALNE,!,"Date Performed: ________________________",?46 "RTN","RAORD6",128,0) I $O(^RADPT("AO",RAOIFN,0))="" W "Case No.: ______________________" "RTN","RAORD6",129,0) E W "Case No.: ______see above_______" "RTN","RAORD6",130,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",131,0) W !,"Technologist Initials: _________________" "RTN","RAORD6",132,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",133,0) W !?46,"Number/Size Films: _____________",!,"Interpreting Phys. Initials: ___________",?65,"_____________",!?65,"_____________",! "RTN","RAORD6",134,0) D HD:($Y+10)>IOSL Q:RAX["^" ; 5-P123 "RTN","RAORD6",135,0) W !,"Comments:" "RTN","RAORD6",136,0) ; "RTN","RAORD6",137,0) TC D EN30^RAO7PC1(RAOIFN),TC^RAORD61 Q:RAX["^" "RTN","RAORD6",138,0) ; "RTN","RAORD6",139,0) DASHLN W ! F I=1:1:5 D HD:($Y+10)>IOSL Q:RAX["^" W !,RALNE ;P18 ; 5-P123 "RTN","RAORD6",140,0) Q "RTN","RAORD6",141,0) ; "RTN","RAORD6",142,0) HD S:'$D(RAPGE) RAPGE=0 D CRCHK Q:$G(RAX)["^" S RATAB=$S($D(RA("ILC")):1,1:16) "RTN","RAORD6",143,0) ;10/12/2006 KAM Remedy tk 162508 Changed next line added "Printed:" "RTN","RAORD6",144,0) W:$Y @IOF W !?RATAB,">>"_$S($D(RACRHD):"Discontinued ",1:"")_"Rad/NM Consultation" W:$D(RA("ILC")) " for ",$E(RA("ILC"),1,17) W "< Attending/Primary Phy. Current "RTN","RAORD6",170,0) ; 'Y'-> Attending/Primary Phy. At Order "RTN","RAORD6",171,0) I X']""!(Y']"") Q 0 "RTN","RAORD6",172,0) I $$UP^XLFSTR(X)="UNKNOWN",($$UP^XLFSTR(Y)="UNKNOWN") Q 0 "RTN","RAORD6",173,0) N A,B,Z S A=+$O(^VA(200,"B",X,"")),B=+$O(^VA(200,"B",Y,"")) "RTN","RAORD6",174,0) I A>0,(B>0),(A=B) S Z=0 "RTN","RAORD6",175,0) E S Z=1 "RTN","RAORD6",176,0) Q Z ; $S(Z=1:"different physician",Z=0:"same physician") "RTN","RAORDS") 0^4^B46087861^B41332744 "RTN","RAORDS",1,0) RAORDS ;HISC/CAH,DAD AISC/RMO-Select Patient's Requests ;6/7/00 16:34 "RTN","RAORDS",2,0) ;;5.0;Radiology/Nuclear Medicine;**15,21,132**;Mar 16, 1998;Build 12 "RTN","RAORDS",3,0) ; Supported IA #1120 reference to EN6^GMRVUTL 5-132 "RTN","RAORDS",4,0) ; "RTN","RAORDS",5,0) Q:'$D(RADFN) D HOME^%ZIS K ^TMP($J,"RAORDS"),RAOUT,RAORDS "RTN","RAORDS",6,0) K ^TMP($J,"PRO-ORD"),^TMP($J,"PRO-REG") "RTN","RAORDS",7,0) ; ^tmp($j,"pro-ord",proc-ien,order-ien) -- outstanding orders "RTN","RAORDS",8,0) ; ^tmp($j,"pro-reg",proc-ien,order-ien) -- actually regist'd procs "RTN","RAORDS",9,0) S ^TMP($J,"RAORDS","Unknown")="" "RTN","RAORDS",10,0) S (RACNT,RASEQ,RAPARENT)=0,RAOSTSYM="dc^c^h^^p^^^s" "RTN","RAORDS",11,0) K RAOSTSNM S X(1)=^DD(75.1,5,0) F I=1:1 S RAOSTS=$P(RAOVSTS,";",I) Q:RAOSTS="" S X=$P($P(X(1),RAOSTS_":",2),";"),RAOSTSNM=$S('$D(RAOSTSNM):X,1:RAOSTSNM_", "_X) "RTN","RAORDS",12,0) F RALP=1:1 S RAOSTS=$P(RAOVSTS,";",RALP) Q:RAOSTS="" F RAOIFN=0:0 S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAOSTS,RAOIFN)) Q:'RAOIFN I $D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0) D SETUTL "RTN","RAORDS",13,0) I '$D(^TMP($J,"RAORDS"))!('RACNT) W !!?5,"No requests available to select for this patient.",! G Q "RTN","RAORDS",14,0) F RAOURG=0:0 S RAOURG=$O(^TMP($J,"RAORDS",RAOURG)) Q:'RAOURG!($D(RAOSEL)) F RAODTI=0:0 S RAODTI=$O(^TMP($J,"RAORDS",RAOURG,RAODTI)) Q:'RAODTI!($D(RAOSEL)) D CHKORD "RTN","RAORDS",15,0) ; "RTN","RAORDS",16,0) Q K ^TMP($J,"RAORDS"),RACNT,RACNT1,RADASH,RADUP,RAERR,RAI,RALCTN,RALOC "RTN","RAORDS",17,0) K RALP,RANUM,RAOASTS,RAODTE,RAODTI,RAOFNS,RAOIFN,RAOIFNS,RAORD0,RAOSEL "RTN","RAORDS",18,0) K RAOSTS,RAOSTSNM,RAOSTSYM,RAOURG,RAOVSTS,RAPHY,RAPAR,RAPRC,RAREQ "RTN","RAORDS",19,0) K RASEL,RASEQ,RAX "RTN","RAORDS",20,0) Q "RTN","RAORDS",21,0) ; "RTN","RAORDS",22,0) SETUTL ; Check if option is to be screened. If yes, apply the screen. "RTN","RAORDS",23,0) I $P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)="P",$O(^RAMIS(71,+$P(RAORD0,U,2),4,0))'>0 Q ; Parent without descendents "RTN","RAORDS",24,0) I $D(RAVSTFLG)#2,$P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)="P" Q ; Cannot choose parent in add exams option "RTN","RAORDS",25,0) I $D(RASCREEN) D Q:'$D(^TMP($J,"RA L-TYPE",RALCTN)) "RTN","RAORDS",26,0) . S RALCTN=+$P(RAORD0,"^",20) "RTN","RAORDS",27,0) . S:'RALCTN RALCTN="Unknown" Q:RALCTN="Unknown" "RTN","RAORDS",28,0) . S RALCTN=$S($D(^RA(79.1,RALCTN,0)):+$P(^(0),"^"),1:"Unknown") "RTN","RAORDS",29,0) . Q:RALCTN="Unknown" "RTN","RAORDS",30,0) . S RALCTN=$S($D(^SC(RALCTN,0)):$P(^(0),"^"),1:"Unknown") "RTN","RAORDS",31,0) . Q "RTN","RAORDS",32,0) S RACNT=RACNT+1,^TMP($J,"RAORDS",$S('$P(RAORD0,"^",6):9,1:$P(RAORD0,"^",6)),9999999.9999-$S($P(RAORD0,"^",21):$P(RAORD0,"^",21),1:$P(RAORD0,"^",16)),RAOIFN,RACNT)=RAORD0 "RTN","RAORDS",33,0) ; store order's indiv procedures "RTN","RAORDS",34,0) I $P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)'="P" S ^TMP($J,"PRO-ORD",$S($P(RAORD0,U,2):$P(RAORD0,U,2),1:0),RAOIFN)="" Q "RTN","RAORDS",35,0) ; for parent orders, must store each descendant's proc ien "RTN","RAORDS",36,0) S RA6=+$P(RAORD0,U,2),RA7=0 "RTN","RAORDS",37,0) F S RA7=$O(^RAMIS(71,RA6,4,RA7)) Q:'RA7 S ^TMP($J,"PRO-ORD",+$P($G(^(RA7,0)),U),RAOIFN)="DESC" "RTN","RAORDS",38,0) Q "RTN","RAORDS",39,0) ; "RTN","RAORDS",40,0) CHKORD F RAOIFN=0:0 S RAOIFN=$O(^TMP($J,"RAORDS",RAOURG,RAODTI,RAOIFN)) Q:'RAOIFN!($D(RAOSEL)) F RACNT1=0:0 S RACNT1=$O(^TMP($J,"RAORDS",RAOURG,RAODTI,RAOIFN,RACNT1)) Q:RACNT1'>0!($D(RAOSEL)) S RAORD0=^(RACNT1) D PRTORD "RTN","RAORDS",41,0) Q "RTN","RAORDS",42,0) ; "RTN","RAORDS",43,0) PRTORD D HD:'(RASEQ#8) Q:$D(RAOSEL) S RASEQ=RASEQ+1,RAOIFNS(RASEQ)=RAOIFN,RAPRC=$S($D(^RAMIS(71,+$P(RAORD0,"^",2),0)):$P(^(0),"^"),1:"Unknown"),RAODTE=9999999.9999-RAODTI "RTN","RAORDS",44,0) S RAPHY=$S($D(^VA(200,+$P(RAORD0,"^",14),0)):$P(^(0),"^"),1:"Unknown"),RALOC=$S($D(^SC(+$P(RAORD0,"^",22),0)):$P(^(0),"^"),1:"Unknown") "RTN","RAORDS",45,0) N RA6 S RA6=$S($P($G(^RAMIS(71,+$P(RAORD0,U,2),0)),U,6)="P"&($P($G(^(0)),U,18)="Y"):"+",1:"") ;parent proc and single rpt "RTN","RAORDS",46,0) W !,$J(RASEQ,2),?4,$P(RAOSTSYM,"^",+$P(RAORD0,"^",5)),?8,$E($P($P(^DD(75.1,6,0),RAOURG_":",2),";"),1,7),?16,RA6 "RTN","RAORDS",47,0) W ?17,$E(RAPRC,1,25),?44,$E(RAODTE,4,5)_"/"_$E(RAODTE,6,7)_"/"_(1700+$E(RAODTE,1,3)),?56,$E(RAPHY,1,11),?69,$E(RALOC,1,11) "RTN","RAORDS",48,0) W !?17,"(",$S($P(RAORD0,U,20)="":"UNKNOWN",1:$E($P($G(^SC(+$G(^RA(79.1,+$P(RAORD0,U,20),0)),0)),U),1,23)),")" "RTN","RAORDS",49,0) D ASKSEL:RACNT=RASEQ "RTN","RAORDS",50,0) Q "RTN","RAORDS",51,0) ; "RTN","RAORDS",52,0) HD D ASKSEL:RASEQ Q:$D(RAOSEL) W @IOF,!?16,"**** Requested Exams for ",$E(RANME,1,20)," ****",?65,$J(RACNT,3),?70,"Requests" "RTN","RAORDS",53,0) ;RTW Add height and weight *** BEGIN *** "RTN","RAORDS",54,0) D ; "RTN","RAORDS",55,0) .N RAHDVITL,RAHDX,DFN,GMRVSTR,X,Y "RTN","RAORDS",56,0) .F RAHDVITL="HT","WT" D "RTN","RAORDS",57,0) .. S DFN=RADFN,GMRVSTR=RAHDVITL "RTN","RAORDS",58,0) .. D EN6^GMRVUTL S RAHDX=$G(X) "RTN","RAORDS",59,0) .. W !?2,$E(RAHDVITL),"eight : ",$P(RAHDX,U,8) "RTN","RAORDS",60,0) .. I $P(RAHDX,U,8)]"" W $S(RAHDVITL="HT":"""",RAHDVITL="WT":" lbs",1:"") "RTN","RAORDS",61,0) .. S Y=$P(RAHDX,U,1) I Y>0 D D^RAUTL W " on ",Y "RTN","RAORDS",62,0) .. Q "RTN","RAORDS",63,0) . Q "RTN","RAORDS",64,0) ;RTW Add height and weight *** END *** "RTN","RAORDS",65,0) W !?4,"St",?8,"Urgency",?17,"Procedure / (Img. Loc.)",?44,"Desired",?56,"Requester",?69,"Req'g Loc",!?4,"--",?8,"-------",?17,"-------------------------",?44,"----------",?56,"-----------",?69,"-----------" "RTN","RAORDS",66,0) Q "RTN","RAORDS",67,0) ; "RTN","RAORDS",68,0) ASKSEL K RADUP,RAORDS S (RAERR,RAI,RANUM)=0 "RTN","RAORDS",69,0) W:$D(RAOPT("REG")) !!,"(Use Pn to replace request 'n' with a Printset procedure.)" "RTN","RAORDS",70,0) W:'$D(RAOPT("REG")) ! "RTN","RAORDS",71,0) W !,"Select Request(s) 1-",RASEQ,$S($D(RAOFNS):" to "_RAOFNS,1:"")," or '^' to Exit: ",$S(RASEQ