Released RA*5*149 SEQ #132 Extracted from mail message **KIDS**:RA*5.0*149^ **INSTALL NAME** RA*5.0*149 "BLD",10854,0) RA*5.0*149^RADIOLOGY/NUCLEAR MEDICINE^0^3180725^y "BLD",10854,1,0) ^^3^3^3180725^ "BLD",10854,1,1,0) The purpose of this patch is to address the issue of the Weight Date not "BLD",10854,1,2,0) properly displaying. Currently, it is using he same information as the "BLD",10854,1,3,0) Height Date. "BLD",10854,4,0) ^9.64PA^^ "BLD",10854,6.3) 1 "BLD",10854,"ABPKG") n "BLD",10854,"KRN",0) ^9.67PA^779.2^20 "BLD",10854,"KRN",.4,0) .4 "BLD",10854,"KRN",.401,0) .401 "BLD",10854,"KRN",.402,0) .402 "BLD",10854,"KRN",.403,0) .403 "BLD",10854,"KRN",.5,0) .5 "BLD",10854,"KRN",.84,0) .84 "BLD",10854,"KRN",3.6,0) 3.6 "BLD",10854,"KRN",3.8,0) 3.8 "BLD",10854,"KRN",9.2,0) 9.2 "BLD",10854,"KRN",9.8,0) 9.8 "BLD",10854,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",10854,"KRN",9.8,"NM",1,0) RAORD5^^0^B33542886 "BLD",10854,"KRN",9.8,"NM","B","RAORD5",1) "BLD",10854,"KRN",19,0) 19 "BLD",10854,"KRN",19.1,0) 19.1 "BLD",10854,"KRN",101,0) 101 "BLD",10854,"KRN",409.61,0) 409.61 "BLD",10854,"KRN",771,0) 771 "BLD",10854,"KRN",779.2,0) 779.2 "BLD",10854,"KRN",870,0) 870 "BLD",10854,"KRN",8989.51,0) 8989.51 "BLD",10854,"KRN",8989.52,0) 8989.52 "BLD",10854,"KRN",8994,0) 8994 "BLD",10854,"KRN","B",.4,.4) "BLD",10854,"KRN","B",.401,.401) "BLD",10854,"KRN","B",.402,.402) "BLD",10854,"KRN","B",.403,.403) "BLD",10854,"KRN","B",.5,.5) "BLD",10854,"KRN","B",.84,.84) "BLD",10854,"KRN","B",3.6,3.6) "BLD",10854,"KRN","B",3.8,3.8) "BLD",10854,"KRN","B",9.2,9.2) "BLD",10854,"KRN","B",9.8,9.8) "BLD",10854,"KRN","B",19,19) "BLD",10854,"KRN","B",19.1,19.1) "BLD",10854,"KRN","B",101,101) "BLD",10854,"KRN","B",409.61,409.61) "BLD",10854,"KRN","B",771,771) "BLD",10854,"KRN","B",779.2,779.2) "BLD",10854,"KRN","B",870,870) "BLD",10854,"KRN","B",8989.51,8989.51) "BLD",10854,"KRN","B",8989.52,8989.52) "BLD",10854,"KRN","B",8994,8994) "BLD",10854,"QUES",0) ^9.62^^ "BLD",10854,"REQB",0) ^9.611^1^1 "BLD",10854,"REQB",1,0) RA*5.0*132^2 "BLD",10854,"REQB","B","RA*5.0*132",1) "MBREQ") 0 "PKG",31,-1) 1^1 "PKG",31,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",31,20,0) ^9.402P^^ "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) 149^3180725 "PKG",31,22,1,"PAH",1,1,0) ^^3^3^3180725 "PKG",31,22,1,"PAH",1,1,1,0) The purpose of this patch is to address the issue of the Weight Date not "PKG",31,22,1,"PAH",1,1,2,0) properly displaying. Currently, it is using he same information as the "PKG",31,22,1,"PAH",1,1,3,0) Height Date. "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") 1 "RTN","RAORD5") 0^1^B33542886^B32521230 "RTN","RAORD5",1,0) RAORD5 ;HISC/CAH,FPT,GJC AISC/RMO-Print A Request ;Jul 25, 2018@16:43:06 "RTN","RAORD5",2,0) ;;5.0;Radiology/Nuclear Medicine;**8,10,15,31,45,75,123,132,149**;Mar 16, 1998;Build 1 "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) ; Reference to ^SC(D0,99) is supported by ICR #4782 "RTN","RAORD5",10,0) ; "RTN","RAORD5",11,0) ; 1-p75 10/12/2006 GJC RA*5*75 Remedy 162508 Modify Patient AGE calc "RTN","RAORD5",12,0) ; 2-p75 10/12/2006 GJC RA*5*75 set REASON FOR STUDY to a local variable "RTN","RAORD5",13,0) ; 5-P123 6/23/2015 MJT RA*5*123 NSR 20140507 print weight & date taken in Radiology requests "RTN","RAORD5",14,0) ; 5-P132 11/1/2017 RTW RA*5*123 NSR 20160706 print height & date taken in Radiology requests "RTN","RAORD5",15,0) ; "RTN","RAORD5",16,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","RAORD5",17,0) N DFN,GMRVSTR,RAHDX,RAPROC "RTN","RAORD5",18,0) G Q:'$D(^DPT(RADFN,0)) S RADPT0=^(0) G Q:'$D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0) "RTN","RAORD5",19,0) S RAPROC=$P(RAORD0,"^",2) "RTN","RAORD5",20,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",21,0) S RA("NME")=$P(RADPT0,"^"),RA("SEX")=$P(RADPT0,"^",2),RA("DOB")=$P(RADPT0,"^",3),RASSN=$$SSN^RAUTL "RTN","RAORD5",22,0) S RA("AGE")=($$FMDIFF^XLFDT($P(RAORD0,U,16),RA("DOB")))\365.25 ;1-p75 "RTN","RAORD5",23,0) S RA("STY_REA")=$P($G(^RAO(75.1,RAOIFN,.1)),U) ;2-p75 "RTN","RAORD5",24,0) S RA("PRC NODE")=$G(^RAMIS(71,+RAPROC,0)) "RTN","RAORD5",25,0) S RA("PRC")=$E($P(RA("PRC NODE"),U),1,36) "RTN","RAORD5",26,0) S RA("PRC")=$S(RA("PRC")]"":RA("PRC"),1:"UNKNOWN") "RTN","RAORD5",27,0) S RA("PRCTY")=$P(RA("PRC NODE"),U,6) "RTN","RAORD5",28,0) S RA("PRCTY")=$$GET1^DIQ(71,RAPROC_",",6) ;$$XTERNAL^RAUTL5(RA("PRCTY"),$P($G(^DD(71,6,0)),U,2)) "RTN","RAORD5",29,0) S RA("PRCTY")=$E(RA("PRCTY"))_$$LOW^XLFSTR($E(RA("PRCTY"),2,99)) "RTN","RAORD5",30,0) S RA("CPT")=+$P(RA("PRC NODE"),U,9) "RTN","RAORD5",31,0) S RA("CPT")=$P($$NAMCODE^RACPTMSC(RA("CPT"),DT),U) "RTN","RAORD5",32,0) S RA("PRCIT")=+$P(RA("PRC NODE"),U,12) "RTN","RAORD5",33,0) S RA("PRCIT")=$P($G(^RA(79.2,RA("PRCIT"),0)),U,3) "RTN","RAORD5",34,0) S RA("CNCAT")="("_RA("PRCIT")_" "_RA("PRCTY")_" "_RA("CPT")_")" "RTN","RAORD5",35,0) S RA("PRC INFO")="",$E(RA("PRC INFO"),1,36)=RA("PRC") "RTN","RAORD5",36,0) S $E(RA("PRC INFO"),38,60)=RA("CNCAT") K RA("CNCAT") "RTN","RAORD5",37,0) S RA("PRC MSG")=$S(+$O(^RAMIS(71,+$P(RAORD0,"^",2),3,0))>0:1,1:0) "RTN","RAORD5",38,0) S RA("OUG")=$$GET1^DIQ(75.1,RAOIFN_",",6) ;$P($P(^DD(75.1,6,0),$P(RAORD0,"^",6)_":",2),";") "RTN","RAORD5",39,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",40,0) S RA("OST")=$$GET1^DIQ(75.1,RAOIFN_",",5)_$S($P(RAOSTSYM,"^",$P(RAORD0,"^",5))="":"",1:" ("_$P(RAOSTSYM,"^",$P(RAORD0,"^",5))_")") "RTN","RAORD5",41,0) S RA("PHY")=$S($D(^VA(200,+$P(RAORD0,"^",14),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","RAORD5",42,0) ; Requesting Physician Phone info "RTN","RAORD5",43,0) D:RA("PHY")'="UNKNOWN" PHONE("R",+$P(RAORD0,"^",14)) "RTN","RAORD5",44,0) ; Get current primary and attending physicians "RTN","RAORD5",45,0) S DFN=RADFN,VA200=1 D IN5^VADPT K VA200 S:'$D(VAIP(18)) VAIP(18)="" "RTN","RAORD5",46,0) ; *** NSR 20140507 Start Mod to print weight & date taken in Radiology requests 5-P123 *** "RTN","RAORD5",47,0) S DFN=RADFN,GMRVSTR="WT" "RTN","RAORD5",48,0) D EN6^GMRVUTL "RTN","RAORD5",49,0) S RA("WT")=$P(X,U,8),Y=$P(X,U) D DD^%DT S RA("WTDT")=Y "RTN","RAORD5",50,0) ;RTW BEGIN RA*5.0*132 ADD HEIGHT "RTN","RAORD5",51,0) S DFN=RADFN,GMRVSTR="HT" "RTN","RAORD5",52,0) D EN6^GMRVUTL S RAHDX=$G(X) "RTN","RAORD5",53,0) S Y=$P(RAHDX,U,1) I Y>0 D DD^%DT S RA("HTDT")=Y "RTN","RAORD5",54,0) S RA("HT")=$P(RAHDX,U,8) "RTN","RAORD5",55,0) ;RTW END RA*5.0*132 ADD HEIGHT "RTN","RAORD5",56,0) ; actual print code located in RAORD6 "RTN","RAORD5",57,0) ; *** NSR 20140507 End Mod to print weight & date taken in Radiology requests *** "RTN","RAORD5",58,0) I '+$G(VAIP(7)) D "RTN","RAORD5",59,0) . ; If the Primary Physician is not found (based on inpatient episode) "RTN","RAORD5",60,0) . ; find the current Primary Care Practitioner (See patch SD*5.3*30) "RTN","RAORD5",61,0) . ; VAIP(7) is null at this point. VAIP(7) will exit this DO block "RTN","RAORD5",62,0) . ; set to the Primary Care Practitioner or null. "RTN","RAORD5",63,0) . N X S X="SDUTL3" X ^%ZOSF("TEST") "RTN","RAORD5",64,0) . S:$T VAIP(7)=$$OUTPTPR^SDUTL3(RADFN) "RTN","RAORD5",65,0) . Q "RTN","RAORD5",66,0) ; Get Current Primary and Attending Physician Phone info "RTN","RAORD5",67,0) S RA("ATTEN")=$S($P(VAIP(18),"^",2)]"":$P(VAIP(18),"^",2),1:"UNKNOWN") "RTN","RAORD5",68,0) D:RA("ATTEN")'="UNKNOWN" PHONE("A",+$G(VAIP(18))) "RTN","RAORD5",69,0) S RA("PRIM")=$S($P(VAIP(7),"^",2)]"":$P(VAIP(7),"^",2),1:"UNKNOWN") "RTN","RAORD5",70,0) D:RA("PRIM")'="UNKNOWN" PHONE("P",+$G(VAIP(7))) "RTN","RAORD5",71,0) ; Requesting location, room-bed "RTN","RAORD5",72,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",73,0) ; Get primary and attending phys as of order date and their phone, etc. "RTN","RAORD5",74,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",75,0) K VAIP S DFN=RADFN,VAIP("D")=+$P(RAORD0,"^",16),VA200=1 D:VAIP("D") IN5^VADPT K VA200 "RTN","RAORD5",76,0) S RA("OATTEN")=$S($P($G(VAIP(18)),"^",2)]"":$P(VAIP(18),"^",2),1:"UNKNOWN") "RTN","RAORD5",77,0) D:RA("OATTEN")'="UNKNOWN" PHONE("OA",+$G(VAIP(18))) "RTN","RAORD5",78,0) S RA("OPRIM")=$S($P($G(VAIP(7)),"^",2)]"":$P(VAIP(7),"^",2),1:"UNKNOWN") "RTN","RAORD5",79,0) D:RA("OPRIM")'="UNKNOWN" PHONE("OP",+$G(VAIP(7))) "RTN","RAORD5",80,0) ; Get other order info (orderer, transport mode, etc.) "RTN","RAORD5",81,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",82,0) S RA("USR")=$S($D(^VA(200,+$P(RAORD0,"^",15),0)):$P(^(0),"^"),1:"UNKNOWN"),RA("TRAN")=$S($P(RAORD0,"^",19)="":"UNKNOWN",1:$$GET1^DIQ(75.1,RAOIFN_",",19)) S:$P(RAORD0,"^",19)="p" RA("PORTABLE")="" "RTN","RAORD5",83,0) K RA("ST"),^TMP($J,"RA DIFF PRC") "RTN","RAORD5",84,0) ;determine if ordered procedure has CM assoc.; return null if none "RTN","RAORD5",85,0) S RACMFLG("O")=$$CMEDIA^RAO7UTL(+$P(RAORD0,U,2),$P(RA("PRC NODE"),U,6)) "RTN","RAORD5",86,0) ; If appropriate, determine exam status and descendant exams "RTN","RAORD5",87,0) I $D(^RADPT("AO",RAOIFN,RADFN)) D DPRC^RAORD2(RAOIFN,RADFN) "RTN","RAORD5",88,0) S RADIV(0)=$G(^SC(+$P(RAORD0,"^",22),0)) "RTN","RAORD5",89,0) S RADIV=+$$SITE^VASITE(DT,+$P(RADIV(0),"^",15)) S:RADIV<0 RADIV=0 "RTN","RAORD5",90,0) S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0))) "RTN","RAORD5",91,0) S RADIVPAR=$S($D(^RA(79,+RADIV,.1)):^(.1),1:"") "RTN","RAORD5",92,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",93,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",94,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",95,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",96,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",97,0) D ^RAORD6 "RTN","RAORD5",98,0) ; "RTN","RAORD5",99,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",100,0) K RACMFLG,RALOC,^TMP($J,"RA DIFF PRC") "RTN","RAORD5",101,0) Q "RTN","RAORD5",102,0) PHONE(X,Y) ; Setup phone information for Resident Physicians, Attending "RTN","RAORD5",103,0) ; Physicians, and Primary Physicians. "RTN","RAORD5",104,0) ; 'X' -> $S('A':'Attending','OA':'Old Attending','OP':'Old Primary', "RTN","RAORD5",105,0) ; ,'P':'Primary','R':'Resident') "RTN","RAORD5",106,0) ; 'Y' -> ien for file 200 "RTN","RAORD5",107,0) ; RA(X_"PHON")=Phone node <> RA(X_"OPHO")=Office phone "RTN","RAORD5",108,0) ; RA(X_"VPGR")=Voice pager <> RA(X_"DPGR")=Digital pager "RTN","RAORD5",109,0) ; RA(X_"PHOINFO")=office phone/voice pager/digital pager "RTN","RAORD5",110,0) S RA(X_"PHON")=$G(^VA(200,+Y,.13)) "RTN","RAORD5",111,0) S RA(X_"OPHO")=$P(RA(X_"PHON"),U,2),RA(X_"VPGR")=$P(RA(X_"PHON"),U,7) "RTN","RAORD5",112,0) S RA(X_"DPGR")=$P(RA(X_"PHON"),U,8) "RTN","RAORD5",113,0) S RA(X_"PHOINFO")=RA(X_"OPHO")_" / "_RA(X_"VPGR")_" / "_RA(X_"DPGR") "RTN","RAORD5",114,0) S:RA(X_"PHOINFO")=" / / " RA(X_"PHOINFO")="Unknown" "RTN","RAORD5",115,0) Q "VER") 8.0^22.2 "BLD",10854,6) ^132 **END** **END**