Released RA*5*154 SEQ #138 Extracted from mail message **KIDS**:RA*5.0*154^ **INSTALL NAME** RA*5.0*154 "BLD",10671,0) RA*5.0*154^RADIOLOGY/NUCLEAR MEDICINE^0^3190214^y "BLD",10671,1,0) ^^2^2^3190212^ "BLD",10671,1,1,0) Registration fine tuning "BLD",10671,1,2,0) Undefined error "BLD",10671,4,0) ^9.64PA^71.11^1 "BLD",10671,4,71.11,0) 71.11 "BLD",10671,4,71.11,2,0) ^9.641^71.11^1 "BLD",10671,4,71.11,2,71.11,0) NEW RAD PROCEDURE WORKUP (File-top level) "BLD",10671,4,71.11,2,71.11,1,0) ^9.6411^9^1 "BLD",10671,4,71.11,2,71.11,1,9,0) CPT CODE "BLD",10671,4,71.11,222) y^n^p^^^^n^^n "BLD",10671,4,71.11,224) "BLD",10671,4,"APDD",71.11,71.11) "BLD",10671,4,"APDD",71.11,71.11,9) "BLD",10671,4,"B",71.11,71.11) "BLD",10671,6.3) 1 "BLD",10671,"KRN",0) ^9.67PA^1.61^23 "BLD",10671,"KRN",.4,0) .4 "BLD",10671,"KRN",.401,0) .401 "BLD",10671,"KRN",.402,0) .402 "BLD",10671,"KRN",.402,"NM",0) ^9.68A^1^1 "BLD",10671,"KRN",.402,"NM",1,0) RA STATUS CHANGE FILE #70^70^0 "BLD",10671,"KRN",.402,"NM","B","RA STATUS CHANGE FILE #70",1) "BLD",10671,"KRN",.403,0) .403 "BLD",10671,"KRN",.5,0) .5 "BLD",10671,"KRN",.84,0) .84 "BLD",10671,"KRN",1.6,0) 1.6 "BLD",10671,"KRN",1.61,0) 1.61 "BLD",10671,"KRN",1.62,0) 1.62 "BLD",10671,"KRN",3.6,0) 3.6 "BLD",10671,"KRN",3.8,0) 3.8 "BLD",10671,"KRN",9.2,0) 9.2 "BLD",10671,"KRN",9.8,0) 9.8 "BLD",10671,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",10671,"KRN",9.8,"NM",1,0) RAREG3^^0^B30767634 "BLD",10671,"KRN",9.8,"NM",2,0) RAHLACK^^0^B10594351 "BLD",10671,"KRN",9.8,"NM",3,0) RASTED^^0^B54897245 "BLD",10671,"KRN",9.8,"NM",4,0) RADD3^^0^B26368598 "BLD",10671,"KRN",9.8,"NM","B","RADD3",4) "BLD",10671,"KRN",9.8,"NM","B","RAHLACK",2) "BLD",10671,"KRN",9.8,"NM","B","RAREG3",1) "BLD",10671,"KRN",9.8,"NM","B","RASTED",3) "BLD",10671,"KRN",19,0) 19 "BLD",10671,"KRN",19.1,0) 19.1 "BLD",10671,"KRN",101,0) 101 "BLD",10671,"KRN",409.61,0) 409.61 "BLD",10671,"KRN",771,0) 771 "BLD",10671,"KRN",779.2,0) 779.2 "BLD",10671,"KRN",870,0) 870 "BLD",10671,"KRN",8989.51,0) 8989.51 "BLD",10671,"KRN",8989.52,0) 8989.52 "BLD",10671,"KRN",8994,0) 8994 "BLD",10671,"KRN","B",.4,.4) "BLD",10671,"KRN","B",.401,.401) "BLD",10671,"KRN","B",.402,.402) "BLD",10671,"KRN","B",.403,.403) "BLD",10671,"KRN","B",.5,.5) "BLD",10671,"KRN","B",.84,.84) "BLD",10671,"KRN","B",1.6,1.6) "BLD",10671,"KRN","B",1.61,1.61) "BLD",10671,"KRN","B",1.62,1.62) "BLD",10671,"KRN","B",3.6,3.6) "BLD",10671,"KRN","B",3.8,3.8) "BLD",10671,"KRN","B",9.2,9.2) "BLD",10671,"KRN","B",9.8,9.8) "BLD",10671,"KRN","B",19,19) "BLD",10671,"KRN","B",19.1,19.1) "BLD",10671,"KRN","B",101,101) "BLD",10671,"KRN","B",409.61,409.61) "BLD",10671,"KRN","B",771,771) "BLD",10671,"KRN","B",779.2,779.2) "BLD",10671,"KRN","B",870,870) "BLD",10671,"KRN","B",8989.51,8989.51) "BLD",10671,"KRN","B",8989.52,8989.52) "BLD",10671,"KRN","B",8994,8994) "BLD",10671,"QDEF") ^^^^NO^^^^NO^^YES "BLD",10671,"QUES",0) ^9.62^^ "BLD",10671,"REQB",0) ^9.611^4^4 "BLD",10671,"REQB",1,0) RA*5.0*47^2 "BLD",10671,"REQB",2,0) RA*5.0*65^2 "BLD",10671,"REQB",3,0) RA*5.0*99^2 "BLD",10671,"REQB",4,0) RA*5.0*144^2 "BLD",10671,"REQB","B","RA*5.0*144",4) "BLD",10671,"REQB","B","RA*5.0*47",1) "BLD",10671,"REQB","B","RA*5.0*65",2) "BLD",10671,"REQB","B","RA*5.0*99",3) "FIA",71.11) NEW RAD PROCEDURE WORKUP "FIA",71.11,0) ^RAMRPF(71.11, "FIA",71.11,0,0) 71.11 "FIA",71.11,0,1) y^n^p^^^^n^^n "FIA",71.11,0,10) "FIA",71.11,0,11) "FIA",71.11,0,"RLRO") "FIA",71.11,0,"VR") 5.0^RA "FIA",71.11,71.11) 1 "FIA",71.11,71.11,9) "KRN",.402,230,-1) 0^1 "KRN",.402,230,0) RA STATUS CHANGE^3190212.1234^^70^^^3190212 "KRN",.402,230,"%D",0) ^^2^2^2940607^^^ "KRN",.402,230,"%D",1,0) "KRN",.402,230,"%D",2,0) This template is used for the Status Tracking of Exams option. "KRN",.402,230,"DIAB",1,2,70.03,12) NUCLEAR MED DATA: "KRN",.402,230,"DIAB",2,2,70.03,9) 80;REQ "KRN",.402,230,"DIAB",2,4,70.21,5) DOSE ADMINISTERED//^S X=$P($G(^RADPTN(DA(1),"NUC",DA,0)),"^",4);T "KRN",.402,230,"DIAB",7,2,70.03,1) 2;REQ "KRN",.402,230,"DIAB",8,2,70.03,8) 32;REQ "KRN",.402,230,"DR",1,70) I '$D(RANEXT)!('$D(RADTE))!('$D(RACN))!('$D(RASK))!('$D(RAMDV))!('$D(DUZ))!('$D(RANXT72))!('$D(RACN0)) W !,$C(7),"Must have RANEXT, RADTE, RACN, RASK, RAMDV, RANXT72, RACN0 and DUZ defined to use this template" S Y="@99"; "KRN",.402,230,"DR",1,70,1) 2///^S X=RADTE;@99;S RAREM="let calling rtn kill RA- vars, due early out from exm status not changed"; "KRN",.402,230,"DR",2,70.02) 50///^S X=RACN; "KRN",.402,230,"DR",3,70.03) S RANXT72(.6)=$G(^RA(72,RANXT72,.6));S RAOPRC=$P($G(^RADPT(DA(2),"DT",DA(1),"P",DA,0)),U,2);S:'$D(RAPRI) RAPRI=RAOPRC;S:$P(RASK,"^",2)'["Y" Y="@03";I $G(RAPRTSET) D WHY1^RASTED S Y="@03";12;I X="" S Y=15;70;@15;15; "KRN",.402,230,"DR",3,70.03,1) I X="",$P(RAMDV,"^",28) W !," Primary Interpreting Staff required for this division",$C(7),! S Y="@15";I X="" S Y="@03";60;@03;S:$P(RASK,"^",3)'["Y" Y="@049";@05;2R~;S RAPRI=+X;S RAREM="did user change the procedure ?"; "KRN",.402,230,"DR",3,70.03,2) I RAPRI=RAOPRC S Y="@049";S RAREM="if procedures change, make sure CM associations are preserved...";D CHGPRC^RAUTL21(RAOPRC,RAPRI,.DA);D WARNPRC^RAUTL;I RAWHICH=0 S Y="@049";I RAWHICH=2 S Y="@047"; "KRN",.402,230,"DR",3,70.03,3) W !,"... Deleting radiopharms ...",!;500///@;@047;I RAWHICH=1 S Y="@049";W !,"... Deleting medications ...",!;K ^RADPT(DA(2),"DT",DA(1),"P",DA,"RX");@049;I '$P(RAMDV,U,7)!($P(^RAMIS(71,RAPRI,0),U,6)'="B") S Y="@051"; "KRN",.402,230,"DR",3,70.03,4) W !?3,$C(7),"A 'detailed' procedure or a 'series' of procedures is required!";2///@;S Y="@05";@051;S:'$$FUTC^RACPTCSV Y="@05";S RAREM="determine if CM is used for this procedure";S RAZCM=$O(^RAMIS(71,RAPRI,"CM","B","")); "KRN",.402,230,"DR",3,70.03,5) 10//^S X=$S(RAZCM'="":"YES",1:"NO");S RAZCM(0)=X;S:$E(RAZCM(0))="N" Y=$$PRGCM^RAMAINU(.DA);D:$E(RAZCM(0))="Y"&('+$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))) STUFCM70^RAMAINU(.DA,RAPRI);S X=X;225; "KRN",.402,230,"DR",3,70.03,6) D:+$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))=0 UPXCM^RAMAINU(.DA,"N");@225;S:$P(RASK,"^",13)'["Y" Y="@063";125;@063;S:$P(RASK,"^",14)'["Y" Y="@067";@065;D:$T(DISCMOD^RACPTMSC)]"" DISCMOD^RACPTMSC;135; "KRN",.402,230,"DR",3,70.03,7) S:'$$FUTCMOD^RACPTCSV Y="@065";@067;S:$P(RASK,"^",4)'["Y" Y="@09";50;@09;S:$P(RASK,"^",5)'["Y" Y="@12";I $G(RAPRTSET) D WHY2^RASTED S Y="@12";13;I X="" S Y="@12";13.1;@12;S:$P(RASK,"^",6)'["Y" Y="@25";18;@25; "KRN",.402,230,"DR",3,70.03,8) S:$P(RASK,"^")'["Y" Y="@11";175;S RATCXX=$$TCPROMPT^RAO7XX;@11;S Y=$$ASKPREG^RAUTL8();S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11);W !," PREGNANT AT TIME OF ORDER ENTRY: ",$$GET1^DIQ(75.1,$G(RAOIFN)_",",13);32R~; "KRN",.402,230,"DR",3,70.03,9) S RAPRSCR=$$PRSCR^RAUTL8(RADFN,RADTI,RACNI,"I") K:RAPRSCR="n" ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCOMM") S:RAPRSCR="n" Y="@8001" K RAPRSCR;80R~;@8001;S:'($P(RASK,"^",7)["Y"&($P(^RAMIS(71,RAPRI,0),"^",5)="y")) Y="@14"; "KRN",.402,230,"DR",3,70.03,10) K RA65 S RA65="P";200///^S X=$$RXMEDIT^RAPSAPI3(.RA65,","_RACNI_","_RADTI_","_RADFN_",",70.03,200,RADTE);S:$G(RA65("RESULT"))'="" Y="MEDICATIONS";@14;S:$P($G(^RA(79.2,+$P(RADT0,"^",2),0)),"^",5)'="Y" Y="@75"; "KRN",.402,230,"DR",3,70.03,11) S:$$NORADIO^RASTREQN(RAPRI,.RANXT72) Y="@75";S RAIEN702=$$EN1^RANMPT1(RADFN,RADTE,RACN);S:RAIEN702=-1 Y="@75";500////^S X=RAIEN702; "KRN",.402,230,"DR",3,70.03,12) ^70.2^RADPTN(^^S I(2,0)=D2 S I(1,0)=D1 S I(0,0)=D0 S Y(1)=$S($D(^RADPT(D0,"DT",D1,"P",D2,0)):^(0),1:"") S X=$P(Y(1),U,28),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");@75;S:'$D(RAIEN702) Y="@80"; "KRN",.402,230,"DR",3,70.03,13) S:$O(^RADPTN(+$G(RAIEN702),"NUC",0)) Y="@80";K RAIEN702;500///@;@80;K RA65; "KRN",.402,230,"DR",4,70.04) .01:2; "KRN",.402,230,"DR",4,70.09) .01; "KRN",.402,230,"DR",4,70.1) .01; "KRN",.402,230,"DR",4,70.11) .01; "KRN",.402,230,"DR",4,70.12) .01; "KRN",.402,230,"DR",4,70.14) .01; "KRN",.402,230,"DR",4,70.15) S:$G(X)="" Y=0;.01///^S X=$$RXMEDIT^RAPSAPI3(.RA65,DA_","_RACNI_","_RADTI_","_RADFN_",");2;S:$P(RASK,"^",8)'["Y" Y="@13";3//^S X="NOW";4//^S X=$P($G(^VA(200,DUZ,0)),"^");@13; "KRN",.402,230,"DR",4,70.2) D DISDEF^RASTREQN(RAIEN702);K RA65 S RA65="R";100///^S X=$$RXMEDIT^RAPSAPI3(.RA65,","_DA_",",70.2,100,RADTE);S:$G(RA65("RESULT"))'="" Y="RADIOPHARMACEUTICALS"; "KRN",.402,230,"DR",4,70.3135) .01; "KRN",.402,230,"DR",4,70.3225) .01; "KRN",.402,230,"DR",5,70.21) S:$G(X)="" Y=0;.01///^S X=$$RXMEDIT^RAPSAPI3(.RA65,DA_","_DA(1)_",");S RAPSDRUG=+X;S RADIOPH=$O(^RAMIS(71,RAPRI,"NUC","B",+$G(RAPSDRUG),0)),(RAHI,RALOW)=""; "KRN",.402,230,"DR",5,70.21,1) S RADIOPH=$G(^RAMIS(71,RAPRI,"NUC",+$G(RADIOPH),0)),RAHI=$P(RADIOPH,"^",5),RALOW=$P(RADIOPH,"^",6);S:"Y"'[$P(RANXT72(.6),"^",3) Y="@1005";@1000;W:RAHI]""!(RALOW]"")!($P(RADIOPH,"^",2)]"") !!; "KRN",.402,230,"DR",5,70.21,2) W:RAHI]"" "High Dose: ",RAHI_" mCi" W:RALOW]"" ?27,"Low Dose: ",RALOW_" mCi" W:$P(RADIOPH,"^",2)]"" ?53,"Usual Dose: ",$P(RADIOPH,"^",2)_" mCi";W:RAHI]""!(RALOW]"")!($P(RADIOPH,"^",2)]"") !;4; "KRN",.402,230,"DR",5,70.21,3) S Y=$$VALDOS^RASTREQN(RALOW,RAHI,X,"@1000","@1005","@99",0);@1005;S:"Y"'[$P(RANXT72(.6),"^",4) Y="@1010";5//^S X="NOW";6//^S X=$P($G(^VA(200,DUZ,0)),"^");@1010;S:"Y"'[$P(RANXT72(.6),"^") Y="@1020";@1015; "KRN",.402,230,"DR",5,70.21,4) W:RAHI]""!(RALOW]"")!($P(RADIOPH,"^",2)]"") !!;W:RAHI]"" "High Dose: ",RAHI_" mCi" W:RALOW]"" ?27,"Low Dose: ",RALOW_" mCi" W:$P(RADIOPH,"^",2)]"" ?53,"Usual Dose: ",$P(RADIOPH,"^",2)_" mCi"; "KRN",.402,230,"DR",5,70.21,5) W:RAHI]""!(RALOW]"")!($P(RADIOPH,"^",2)]"") !;7T~//^S X=$P($G(^RADPTN(DA(1),"NUC",DA,0)),"^",4);S RADOSE=X;S Y=$$VALDOS^RASTREQN(RALOW,RAHI,RADOSE,"@1015","@1020","@99",1);@1020; "KRN",.402,230,"DR",5,70.21,6) S:'$D(RADOSE) RADOSE=$P($G(^RADPTN(DA(1),"NUC",DA,0)),"^",7);S RANM702=$G(^RADPTN(DA(1),"NUC",DA,0));S:$P(^RAMIS(71,RAPRI,0),"^",19)'="y"!('RADOSE) Y="@1030";S:$P(RANM702,"^",2)]""&($P(RANM702,"^",3)]"") Y="@1030";3;2;@1030; "KRN",.402,230,"DR",5,70.21,7) S:"Y"'[$P(RANXT72(.6),"^",5) Y="@1040";8//^S X=$S($P($G(RANM702),"^",5)]"":$$FMTE^XLFDT($P(RANM702,"^",5),1),1:"NOW");9//^S X=$P($G(^VA(200,DUZ,0)),"^");@1040; "KRN",.402,230,"DR",5,70.21,8) S:$P(RANM702,"^",10)]""!($P($G(^RAMIS(71,RAPRI,0)),"^",19)'="y") Y="@1050";10;@1050;S:"Y"'[$P(RANXT72(.6),"^",7) Y="@1060";11//^S X=$$GET1^DIQ(71.6,+$P(RADIOPH,"^",3)_",",.01);S RAR1=+X;S:'+$O(^RAMIS(71.6,RAR1,"SITE",0)) Y="@1070"; "KRN",.402,230,"DR",5,70.21,9) 12//^S X=$$GET1^DIQ(71.7,+$P(RADIOPH,"^",4)_",",.01);@1070;S:'($P($G(^RADPTN(DA(1),"NUC",DA,0)),"^",11)]""&($P($G(^RAMIS(71.6,RAR1,0)),"^",3)="Y")) Y="@1080";12.5;@1080;@1060;S:"Y"'[$P(RANXT72(.6),"^",8) Y="@1090";13;@1090; "KRN",.402,230,"DR",5,70.21,10) S:"Y"'[$P(RANXT72(.6),"^",9) Y="@1100";14;15//^S X=$$EXTERNAL^DILFD(71.08,7,"",$P(RADIOPH,"^",7));@1100; "KRN",.402,230,"ROUOLD") RACTTK "MBREQ") 0 "ORD",7,.402) .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%) "ORD",7,.402,0) INPUT TEMPLATE "PKG",18,-1) 1^1 "PKG",18,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",18,22,0) ^9.49I^1^1 "PKG",18,22,1,0) 5.0^3051109^2980407^50 "PKG",18,22,1,"PAH",1,0) 154^3190214 "PKG",18,22,1,"PAH",1,1,0) ^^2^2^3190214 "PKG",18,22,1,"PAH",1,1,1,0) Registration fine tuning "PKG",18,22,1,"PAH",1,1,2,0) Undefined error "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") 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") 4 "RTN","RADD3") 0^4^B26368598^B25368385 "RTN","RADD3",1,0) RADD3 ;HISC/SWM-Radiology Data Dictionary Utility Routine ;12 Feb 2019 12:31 PM "RTN","RADD3",2,0) ;;5.0;Radiology/Nuclear Medicine;**18,65,154**;Mar 16, 1998;Build 1 "RTN","RADD3",3,0) ; "RTN","RADD3",4,0) ;Supported IA #2056 reference to GET1^DIQ "RTN","RADD3",5,0) ;Supported IA #10142 reference to EN^DDIOL "RTN","RADD3",6,0) ;Supported IA #2053 reference to UPDATE^DIE, FILE^DIE "RTN","RADD3",7,0) ;Supported IA #10103 reference to NOW^XLFDT "RTN","RADD3",8,0) ; "RTN","RADD3",9,0) PAIR ; "RTN","RADD3",10,0) ; called from file 71.9's field SOURCE "RTN","RADD3",11,0) ; SOURCE may be added normally via the "RA NM EDIT LOT" option, "RTN","RADD3",12,0) ; or it may be added via one of the 3 exam edits when the LOT "RTN","RADD3",13,0) ; prompt appears for the case's Radiopharm. This LOT prompt "RTN","RADD3",14,0) ; allows adding new LOT on-the-fly, which causes the LOT's "RTN","RADD3",15,0) ; associated SOURCE, EXPIRATION DATE, KIT # to be prompted "RTN","RADD3",16,0) ; and the current case's Radiopharm to be stuffed into the new LOT's "RTN","RADD3",17,0) ; Radiopharm field. The SOURCE field invokes this subroutine to: "RTN","RADD3",18,0) ; re-set DR string to stuff matching radiopharm "RTN","RADD3",19,0) ; not allow spacebar return for radioph "RTN","RADD3",20,0) ; RA*5*65 removed the Fileman Identifier for file 79.1's RADIOPHARM "RTN","RADD3",21,0) ; so by default, the DR will just be "2;3;4;" without the "5;". "RTN","RADD3",22,0) ; "RTN","RADD3",23,0) N RA1,RA2,RA3 "RTN","RADD3",24,0) I $D(RAOPT("EDITPT"))!($D(RAOPT("EDITCN")))!($D(RAOPT("STATRACK"))) D "RTN","RADD3",25,0) . S RA1=$$EN1^RAPSAPI(RAPSDRUG,.01) "RTN","RADD3",26,0) . I $G(DR)'[";5",$G(DIE)="^RAMIS(71.9,",+$G(RAPSDRUG),RA1]"" S DR=DR_"5///"_RA1 K ^DISV(DUZ,"^RAMIS(71.9,") "RTN","RADD3",27,0) . Q "RTN","RADD3",28,0) ; check pairing of number/id with source "RTN","RADD3",29,0) ; called by input transform of file 71.9'S field 2 (source) "RTN","RADD3",30,0) S (RA1,RA2,RA3)="" "RTN","RADD3",31,0) Q:$G(DA)="" Q:$G(D)="" "RTN","RADD3",32,0) F S RA1=$O(^RAMIS(71.9,"B",$P(D,U),RA1)) Q:'RA1 I DA'=RA1 S:$P(^RAMIS(71.9,RA1,0),U,2)=+Y RA2=1 ;found a match so set ra2=1 "RTN","RADD3",33,0) W:RA2 !!,"** There's already a NUMBER/ID=",$P(D,U)," and SOURCE=",$P(Y,U,2)," **",! "RTN","RADD3",34,0) K:RA2 X "RTN","RADD3",35,0) Q "RTN","RADD3",36,0) SCRLOT() ;screen lot # from file 70.2 "RTN","RADD3",37,0) ;lot's exp. dt must be within d/t dose admin, if no admin, use exam dt "RTN","RADD3",38,0) ; if lot's exp. dt is null, allow as choice (don't check) "RTN","RADD3",39,0) ;lot's radiopharm must match exam's radiopharm "RTN","RADD3",40,0) ; if lot's radiopharm is null, don't allow as choice "RTN","RADD3",41,0) ;Y pointer to lot file "RTN","RADD3",42,0) ;RA0A date/time dose administered "RTN","RADD3",43,0) ;RA0E date/time exam "RTN","RADD3",44,0) ;RALOTEXP lot's expiration date "RTN","RADD3",45,0) ;RA0RAD exam's radiopharmaceutical "RTN","RADD3",46,0) ;RALOTRAD lot's radiopharmaceutical "RTN","RADD3",47,0) ;RARETUR return value of screen, 0=failed, 1=passed "RTN","RADD3",48,0) I '$D(Y)#2!('$D(DA))!('$D(DA(1))) Q 0 "RTN","RADD3",49,0) N RA0A,RA0E,RALOTEXP,RA0RAD,RALOTRAD,RARETURN "RTN","RADD3",50,0) S RARETURN=0 "RTN","RADD3",51,0) S RA0E=$P(^RADPTN(DA(1),0),U,2),RA0A=$P(^("NUC",DA,0),U,8),RA0RAD=$P(^(0),U),RALOTEXP=$P(^RAMIS(71.9,+Y,0),U,3),RALOTRAD=$P(^(0),U,5) "RTN","RADD3",52,0) I $S(RALOTEXP="":1,RA0A:RALOTEXP>RA0A,1:RALOTEXP>RA0E),(RA0RAD=RALOTRAD) S RARETURN=1 "RTN","RADD3",53,0) Q RARETURN "RTN","RADD3",54,0) ; "RTN","RADD3",55,0) GETID(Y) ; Pass back a string of data which will be used as an "RTN","RADD3",56,0) ; identifier when lookups are done on the Imaging Locations (79.1) file "RTN","RADD3",57,0) ; Input : Y -> ien of entry in 79.1 "RTN","RADD3",58,0) ; Output: string of data relevent to the entry in file 79.1 "RTN","RADD3",59,0) ; Location I-type_"-"_Station # of Rad/Nuc Med Division "RTN","RADD3",60,0) N RA791 S RA791(0)=$G(^RA(79.1,Y,0)) "RTN","RADD3",61,0) S RA791("DIV")=$G(^RA(79.1,Y,"DIV")) "RTN","RADD3",62,0) Q "("_$$GET1^DIQ(79.2,+$P(RA791(0),"^",6),.01)_"-"_$$GET1^DIQ(4,+$P(RA791("DIV"),"^"),99)_")" "RTN","RADD3",63,0) ; "RTN","RADD3",64,0) DELDESC(RAIEN) ; This sub-routine will determine if descendents can be "RTN","RADD3",65,0) ; deleted from parent procedures. If only one descendent exists, and "RTN","RADD3",66,0) ; the parent is on the common procedure list do not allow the deletion "RTN","RADD3",67,0) ; of the descendent. "RTN","RADD3",68,0) ; Input : RAIEN (the DA array for the Rad/Nuc Med Procedure file.) "RTN","RADD3",69,0) ; Output: 0 if ok to delete, 1 if not ok to delete "RTN","RADD3",70,0) ; Called from: ^DD(71.05,.01,"DEL",1,0) node "RTN","RADD3",71,0) N I,RA713,RATTL S (I,RA713,RATTL)=0 "RTN","RADD3",72,0) S:$D(^RAMIS(71.3,"B",RAIEN(1))) RA713=+$O(^RAMIS(71.3,"B",RAIEN(1),0)) "RTN","RADD3",73,0) S:RA713>0 RA713(0)=$G(^RAMIS(71.3,RA713,0)) "RTN","RADD3",74,0) F S I=$O(^RAMIS(71,RAIEN(1),4,I)) Q:I'>0 S RATTL=RATTL+1 "RTN","RADD3",75,0) I RA713,($P(RA713(0),"^",5)=""),(RATTL=1) D Q 1 "RTN","RADD3",76,0) . ; don't allow deletion of the last descendent on procedures that are "RTN","RADD3",77,0) . ; currently active in the common procedure file. "RTN","RADD3",78,0) . N RATXT S RATXT(1)=" " "RTN","RADD3",79,0) . S RATXT(2)="You cannot delete the last or only descendent from a" "RTN","RADD3",80,0) . S RATXT(3)="parent procedure when the parent procedure is an active" "RTN","RADD3",81,0) . S RATXT(4)="common procedure.",RATXT(5)=$C(7) D EN^DDIOL(.RATXT) "RTN","RADD3",82,0) . Q "RTN","RADD3",83,0) Q 0 ; common procedure with more than one descendent, ok to delete "RTN","RADD3",84,0) ; "RTN","RADD3",85,0) REACMMN(RADA) ; Check to see if a commom procedure can be re-activated. "RTN","RADD3",86,0) ; This sub-routine checks if this common is a parent w/o descendents. "RTN","RADD3",87,0) ; If true, this common procedure cannot be re-activated. "RTN","RADD3",88,0) ; Input : RADA - ien of the entry in 71.3 "RTN","RADD3",89,0) ; Output: 0 if ok to delete, 1 if not ok to delete "RTN","RADD3",90,0) ; Called from ^DD(71.3,4,"DEL",1,0) "RTN","RADD3",91,0) N RA713 S RA713=$G(^RAMIS(71.3,RADA,0)) "RTN","RADD3",92,0) I $P($G(^RAMIS(71,+RA713,0)),"^",6)="P",('$O(^RAMIS(71,+RA713,4,0))) D Q 1 "RTN","RADD3",93,0) . N RATXT S RATXT(1)=" " "RTN","RADD3",94,0) . S RATXT(2)="You cannot re-activate a common parent procedure without descendents." "RTN","RADD3",95,0) . S RATXT(3)=$C(7) D EN^DDIOL(.RATXT) "RTN","RADD3",96,0) . Q "RTN","RADD3",97,0) Q 0 ; ok to delete "RTN","RADD3",98,0) ; "RTN","RADD3",99,0) X7005(RADFN,RADTI,RACNI,RAMDV,RAQED,RASTI,RAWHO) ;update the EXAM "RTN","RADD3",100,0) ; STATUS TIMES (70.05) multiple. Called from RASTED (will be "RTN","RADD3",101,0) ; called from RAUTL1 in the future) "RTN","RADD3",102,0) ; "RTN","RADD3",103,0) ; input variables: "RTN","RADD3",104,0) ; ---------------- "RTN","RADD3",105,0) ; RADFN=patient dfn, RADTI=exam date/time (inverse) "RTN","RADD3",106,0) ; RACNI=exam record ien (70.03), RAMDV=division parameters "RTN","RADD3",107,0) ; RAQED=task queued(1=yes;0=no), RASTI=exam status "RTN","RADD3",108,0) ; RAWHO=editing person "RTN","RADD3",109,0) ; "RTN","RADD3",110,0) N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y "RTN","RADD3",111,0) S RAQED=+$G(RAQED) ; if tasked 1, else 0 "RTN","RADD3",112,0) S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," "RTN","RADD3",113,0) S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) "RTN","RADD3",114,0) D UPDATE^DIE(,"RAFDA","RAIEN") ; RAIEN(1)=ien of new record "RTN","RADD3",115,0) K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added "RTN","RADD3",116,0) I $P(RAMDV,"^",11),('RAQED) D "RTN","RADD3",117,0) .S DIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"","_RACNI_",""T""," "RTN","RADD3",118,0) .S DA=RAIEN(1),DR=".01" D ^DIE "RTN","RADD3",119,0) S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," "RTN","RADD3",120,0) S RAFDA(70.05,RAIENS,2)=RASTI "RTN","RADD3",121,0) S RAFDA(70.05,RAIENS,3)=$G(RAWHO) "RTN","RADD3",122,0) D FILE^DIE(,"RAFDA") "RTN","RADD3",123,0) Q "RTN","RADD3",124,0) A7007(RADFN,RADTI,RACNI,RAWHO,RATC) ; update the ACTIVITY LOG (70.07) "RTN","RADD3",125,0) ; multiple. Called from RASTED (will be called from RAUTL1 in the "RTN","RADD3",126,0) ; future) "RTN","RADD3",127,0) ; "RTN","RADD3",128,0) ; input variables: "RTN","RADD3",129,0) ; ---------------- "RTN","RADD3",130,0) ; RADFN=patient dfn, RADTI=exam date/time (inverse) "RTN","RADD3",131,0) ; RACNI=exam record ien (70.03), RAWHO=editing person "RTN","RADD3",132,0) ; RATC=technologist comments (optional) "RTN","RADD3",133,0) ; "RTN","RADD3",134,0) N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,RATOA,X,Y "RTN","RADD3",135,0) S RATOA=$S($D(RAOPT("STATRACK")):"S",1:"U") ;p154 Reflect option used "RTN","RADD3",136,0) S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," "RTN","RADD3",137,0) S RAFDA(70.07,RAIENS,.01)="NOW" "RTN","RADD3",138,0) D UPDATE^DIE("E","RAFDA","RAIEN") ;RAIEN(1)=ien of new record "RTN","RADD3",139,0) K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added "RTN","RADD3",140,0) S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," "RTN","RADD3",141,0) S RAFDA(70.07,RAIENS,2)=RATOA "RTN","RADD3",142,0) S RAFDA(70.07,RAIENS,3)=$G(RAWHO) "RTN","RADD3",143,0) S:$G(RATC)]"" RAFDA(70.07,RAIENS,4)=RATC "RTN","RADD3",144,0) D FILE^DIE(,"RAFDA") "RTN","RADD3",145,0) Q "RTN","RADD3",146,0) ; "RTN","RADD3",147,0) ;updates EXAM STATUS "RTN","RADD3",148,0) U70033(RA18DFN,RA18DTI,RA18CNI,RA18ST) ; "RTN","RADD3",149,0) N %,D,D0,DA,DIC,DIE,DQ,DR,RA18FDA,RA18IENS,X,Y "RTN","RADD3",150,0) S RA18IENS=RA18CNI_","_RA18DTI_","_RA18DFN_"," "RTN","RADD3",151,0) S RA18FDA(70.03,RA18IENS,3)=RA18ST "RTN","RADD3",152,0) D FILE^DIE(,"RA18FDA") "RTN","RADD3",153,0) Q "RTN","RADD3",154,0) ; "RTN","RAHLACK") 0^2^B10594351^B10346213 "RTN","RAHLACK",1,0) RAHLACK ;HISC/PAV - Process Appl Ack for (ORM) and (ORU) Msgs;14 Feb 2019 10:40 AM "RTN","RAHLACK",2,0) ;;5.0;Radiology/Nuclear Medicine;**47,154**;June 16, 2006;Build 1 "RTN","RAHLACK",3,0) ; Based on information from incoming Ack, e-mail message is "RTN","RAHLACK",4,0) ; sent to Mail group: G.RAD HL7 MESSAGES "RTN","RAHLACK",5,0) ; "RTN","RAHLACK",6,0) ;Integration Agreements "RTN","RAHLACK",7,0) ;---------------------- "RTN","RAHLACK",8,0) ;MSG^DIALOG(2050); $$GETAPP^HLCS2(2887); $$MSG^HLCSUTL(3099);^XMD(10070) "RTN","RAHLACK",9,0) ; "RTN","RAHLACK",10,0) MAIN ; Process incoming ACK, called from 2.4 protocols "RTN","RAHLACK",11,0) ; "RTN","RAHLACK",12,0) N CNT,ERR,ERROR,EXIT,GROUP,HLFS,HLCS,HLSCS,I,NUMBER,RAERR,SEG,X,Y "RTN","RAHLACK",13,0) D INIT,PROCESS,EXIT "RTN","RAHLACK",14,0) Q "RTN","RAHLACK",15,0) ; "RTN","RAHLACK",16,0) INIT ; initialize "RTN","RAHLACK",17,0) ; "RTN","RAHLACK",18,0) ;S DUZ(0)="@" "RTN","RAHLACK",19,0) ; "RTN","RAHLACK",20,0) S ERROR=0 "RTN","RAHLACK",21,0) S HLFS=HL("FS"),HLCS=$E(HL("ECH")) "RTN","RAHLACK",22,0) S HLSCS=$E(HL("ECH"),4),HLREP=$E(HL("ECH"),2) "RTN","RAHLACK",23,0) Q "RTN","RAHLACK",24,0) ; "RTN","RAHLACK",25,0) PROCESS ; pull message text "RTN","RAHLACK",26,0) ; "RTN","RAHLACK",27,0) N SEG "RTN","RAHLACK",28,0) F X HLNEXT Q:HLQUIT'>0 S SEG=$P(HLNODE,HLFS) D:SEG'="" "RTN","RAHLACK",29,0) .D:"^MSH^MSA^ERR^"[(U_SEG_U) @SEG "RTN","RAHLACK",30,0) Q "RTN","RAHLACK",31,0) ; "RTN","RAHLACK",32,0) MSH ; -- MSH segment "RTN","RAHLACK",33,0) ; "RTN","RAHLACK",34,0) Q "RTN","RAHLACK",35,0) ; "RTN","RAHLACK",36,0) MSA ; -- MSA segment "RTN","RAHLACK",37,0) ; "RTN","RAHLACK",38,0) N CODE,DA,DIC,RAHLMA,RAMSA,RAMSG,X "RTN","RAHLACK",39,0) S CODE=$P(HLNODE,HLFS,2) "RTN","RAHLACK",40,0) I CODE="AE"!(CODE="AR") D "RTN","RAHLACK",41,0) .S ERROR=ERROR_U_$P(HLNODE,HLFS,4,99) "RTN","RAHLACK",42,0) .S RAERR("DIMSG",1)=CODE_" ACK Code received to the Message ID: "_$P(HLNODE,HLFS,3) "RTN","RAHLACK",43,0) .S RAMSA=$P(HLNODE,HLFS,3),RAMSG=$$MSG^HLCSUTL(RAMSA,"RAHLMA(1)") "RTN","RAHLACK",44,0) .I RAMSG>0 S RAERR("DIMSG",2)=RAHLMA(1,1) "RTN","RAHLACK",45,0) Q "RTN","RAHLACK",46,0) ; "RTN","RAHLACK",47,0) ERR ; -- ERR segment "RTN","RAHLACK",48,0) ; "RTN","RAHLACK",49,0) ; Set ERR segment handler here... "RTN","RAHLACK",50,0) Q "RTN","RAHLACK",51,0) ; "RTN","RAHLACK",52,0) EM(MID,ERROR,RAERR,XMSUB,XMY) ; error message "RTN","RAHLACK",53,0) ; "RTN","RAHLACK",54,0) N GROUP,RAMPG,RAX,XMDUZ,XMMG,XMTEXT,XMZ "RTN","RAHLACK",55,0) ; "RTN","RAHLACK",56,0) D MSG^DIALOG("AM",.RAX,80,"","RAERR") "RTN","RAHLACK",57,0) ; "RTN","RAHLACK",58,0) S RAX(.1)="HL7 message ID: "_$G(MID) "RTN","RAHLACK",59,0) S RAX(.2)="",RAX(.3)=$G(ERROR) "RTN","RAHLACK",60,0) S:$G(XMSUB)="" XMSUB="RAD ACK ERROR/WARNING/INFO" "RTN","RAHLACK",61,0) ;p154 - undefined HL("SAN") error, add $D check "RTN","RAHLACK",62,0) S RAMPG=$S($D(HL("SAN")):$P($$GETAPP^HLCS2(HL("SAN")),U,1),1:"") ;RAMPG="G.RAD HL7 MESSAGES" "RTN","RAHLACK",63,0) S:'$L(RAMPG) RAMPG="G.RAD HL7 MESSAGES" "RTN","RAHLACK",64,0) S XMY(RAMPG)="",XMDUZ=.5 "RTN","RAHLACK",65,0) S XMTEXT="RAX(" "RTN","RAHLACK",66,0) ; "RTN","RAHLACK",67,0) D ^XMD "RTN","RAHLACK",68,0) Q "RTN","RAHLACK",69,0) ; "RTN","RAHLACK",70,0) GSTATUS(HLRESLT,ED) ; "RTN","RAHLACK",71,0) Q:'$D(HLRESLT) "RTN","RAHLACK",72,0) N I,RAERR,ERROR,XMSUB "RTN","RAHLACK",73,0) S XMSUB="RAD HL7: Error in GENERATE^HLMA" "RTN","RAHLACK",74,0) S ERROR="For Event Driver: "_$P($G(^ORD(101,+$G(ED),0)),U) "RTN","RAHLACK",75,0) I +$P(HLRESLT,U,2)!$L($P(HLRESLT,U,3)) D "RTN","RAHLACK",76,0) .S RAERR(1)=$P(HLRESLT,U,2),RAERR(2)=$P(HLRESLT,U,3) "RTN","RAHLACK",77,0) .D EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB_" single subscriber") "RTN","RAHLACK",78,0) .K RAERR "RTN","RAHLACK",79,0) S I=0 F S I=$O(HLRESLT(I)) Q:'I D:$L($P(HLRESLT(I),U,2))!$L($P(HLRESLT(I),U,3)) "RTN","RAHLACK",80,0) .S RAERR(1)=$P(HLRESLT(I),U,2),RAERR(2)=$P(HLRESLT(I),U,3) "RTN","RAHLACK",81,0) .D EM(+HLRESLT(I),ERROR,.RAERR,XMSUB_" multi subscribers") "RTN","RAHLACK",82,0) .K RAERR "RTN","RAHLACK",83,0) Q "RTN","RAHLACK",84,0) ; "RTN","RAHLACK",85,0) ASTATUS(HLRESLT,MID,VNDR) ;ACK error "RTN","RAHLACK",86,0) ; "RTN","RAHLACK",87,0) Q:'$D(HLRESLT) "RTN","RAHLACK",88,0) N I,RAERR,ERROR,XMSUB "RTN","RAHLACK",89,0) S XMSUB="RAD HL7: Error in GENACK^HLMA1" "RTN","RAHLACK",90,0) S ERROR="ACK to:"_VNDR_" Message ID: "_MID "RTN","RAHLACK",91,0) I +$P(HLRESLT,U,2)!$L($P(HLRESLT,U,3)) D "RTN","RAHLACK",92,0) .S RAERR(1)=$P(HLRESLT,U,2),RAERR(2)=$P(HLRESLT,U,3) "RTN","RAHLACK",93,0) .D EM(+HLRESLT,ERROR_">>"_HLRESLT_"<<",.RAERR,XMSUB) "RTN","RAHLACK",94,0) .K RAERR "RTN","RAHLACK",95,0) Q "RTN","RAHLACK",96,0) EXIT ; cleanup, and quit. "RTN","RAHLACK",97,0) Q "RTN","RAREG3") 0^1^B30767634^B30473392 "RTN","RAREG3",1,0) RAREG3 ;HISC/CAH,DAD,FPT,GJC-Register Rad/NM Patient (cont.) ;27 Dec 2018 10:03 AM "RTN","RAREG3",2,0) ;;5.0;Radiology/Nuclear Medicine;**8,137,144,154**;Mar 16, 1998;Build 1 "RTN","RAREG3",3,0) ; "RTN","RAREG3",4,0) RSBIT ; renumber selections by imaging type "RTN","RAREG3",5,0) ; The RAORDS array has the list of orders the user selected to register "RTN","RAREG3",6,0) ; in the order the user entered them. This subroutine will reorganize "RTN","RAREG3",7,0) ; the array so the orders are arranged by imaging type of their "RTN","RAREG3",8,0) ; procedure starting with the imaging type the user is currently signed "RTN","RAREG3",9,0) ; on with followed by the ascending internal entry number of the "RTN","RAREG3",10,0) ; remaining imaging types. "RTN","RAREG3",11,0) ; "RTN","RAREG3",12,0) Q:'$D(RAORDS) "RTN","RAREG3",13,0) K RALOOP,RAORDST "RTN","RAREG3",14,0) F RALOOP=1:1 Q:'$D(RAORDS(RALOOP)) D "RTN","RAREG3",15,0) .S RAON=+$P(RAORDS(RALOOP),U,1) Q:'RAON "RTN","RAREG3",16,0) .S RAPN=+$P(^RAO(75.1,RAON,0),U,2) Q:'RAPN "RTN","RAREG3",17,0) .S RAIN=+$P(^RAMIS(71,RAPN,0),U,12) Q:'RAIN "RTN","RAREG3",18,0) .S RAORDST(RAIN,RALOOP)=RAON "RTN","RAREG3",19,0) .Q "RTN","RAREG3",20,0) S RAIMGTYN=+$O(^RA(79.2,"B",RAIMGTY,0)) Q:'RAIMGTYN "RTN","RAREG3",21,0) K RAORDS S (RALOOP,RAIN)=0 "RTN","RAREG3",22,0) I $D(RAORDST(RAIMGTYN)) F S RAIN=$O(RAORDST(RAIMGTYN,RAIN)) Q:'RAIN S RALOOP=RALOOP+1,RAORDS(RALOOP)=+RAORDST(RAIMGTYN,RAIN) K RAORDST(RAIMGTYN,RAIN) "RTN","RAREG3",23,0) I $D(RAORDST) S RAIMGTYN=0 F S RAIMGTYN=$O(RAORDST(RAIMGTYN)) Q:'RAIMGTYN S RAIN=0 F S RAIN=$O(RAORDST(RAIMGTYN,RAIN)) Q:'RAIN S RALOOP=RALOOP+1,RAORDS(RALOOP)=+RAORDST(RAIMGTYN,RAIN) "RTN","RAREG3",24,0) K RAIMGTYN,RAIN,RALOOP,RAON,RAORDST,RAPN "RTN","RAREG3",25,0) Q "RTN","RAREG3",26,0) SETDISV ; when registering procedures of different imaging types set imaging "RTN","RAREG3",27,0) ; location default value in DIC("B") if only one location associated with "RTN","RAREG3",28,0) ; imaging type. "RTN","RAREG3",29,0) N RACNT,RAITNHLD,RAITNXT,RALOOP "RTN","RAREG3",30,0) S (RACNT,RAITNXT)=0 "RTN","RAREG3",31,0) F RALOOP=0:0 S RAITNXT=$O(^RA(79.1,"BIMG",RAITN,RAITNXT)) Q:'RAITNXT S RACNT=RACNT+1,RAITNHLD=RAITNXT "RTN","RAREG3",32,0) ;I RACNT=1 S ^DISV(+DUZ,"^RA(79.1,")=RAITNHLD "RTN","RAREG3",33,0) I RACNT=1,RAITNHLD,$G(^RA(79.1,RAITNHLD,0))]"" S DIC("B")=$P($G(^SC(+^(0),0)),"^") "RTN","RAREG3",34,0) Q "RTN","RAREG3",35,0) SL ; switch locations "RTN","RAREG3",36,0) ; Prompt the user to switch locations if the current sign-on imaging "RTN","RAREG3",37,0) ; type does not match the procedure's imaging type. "RTN","RAREG3",38,0) ; comment out 06/10/97 D EXAMSET^RAREG2 S RAPARENT=0 "RTN","RAREG3",39,0) S RAITN=$P(^RAMIS(71,+$P(Y,U,2),0),U,12) "RTN","RAREG3",40,0) ;P154 Check switched to location until it's correct or user ^ out. "RTN","RAREG3",41,0) F Q:RAITN=+$O(^RA(79.2,"B",RAIMGTY,0))!(RAQUIT=1) D "RTN","RAREG3",42,0) .S RAMLCHLD=RAMLC,RAYHOLD=Y,RAPROLOC=$P(^RA(79.2,RAITN,0),U,1),RAMDIVHD=RAMDIV "RTN","RAREG3",43,0) .D LABEL "RTN","RAREG3",44,0) .W !!?7,"Current Imaging Type: ",RAIMGTY "RTN","RAREG3",45,0) .W !?5,"Procedure Imaging Type: ",RAPROLOC "RTN","RAREG3",46,0) .W !!,"You must switch to a location of ",RAPROLOC," imaging type.",!! "RTN","RAREG3",47,0) .D SETDISV "RTN","RAREG3",48,0) .K RAMLC S RASWLOC="" "RTN","RAREG3",49,0) .D SET^RAPSET1 "RTN","RAREG3",50,0) .K RASWLOC "RTN","RAREG3",51,0) .I '$D(RAMLC) S RAQUIT=1,RAMLC=RAMLCHLD Q "RTN","RAREG3",52,0) .I RAMDIVHD'=RAMDIV W !!,"You have switched Divisions from: ",$P(^DIC(4,+RAMDIVHD,0),U),!,?30,"to: ",$P(^DIC(4,+RAMDIV,0),U),! "RTN","RAREG3",53,0) .D DT Q:RAQUIT "RTN","RAREG3",54,0) .S Y=RAYHOLD "RTN","RAREG3",55,0) .Q "RTN","RAREG3",56,0) K RAITN,RAMDIVHD,RAMLCHLD,RAPROLOC,RAYHOLD "RTN","RAREG3",57,0) Q "RTN","RAREG3",58,0) DT ; prompt for new imaging date/time when imaging type changes "RTN","RAREG3",59,0) Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RAREG3",60,0) N RAHRS S RAHRS=+$P($G(^RA(79,+RAMDIV,.1)),"^",24) ;How many hrs in adv? "RTN","RAREG3",61,0) R !!,"Imaging Exam Date/Time: NOW// ",X:DTIME "RTN","RAREG3",62,0) I '$T!(X=" ")!(X="^") S RAQUIT=1 Q "RTN","RAREG3",63,0) S:X="" RANOW="",X="NOW" "RTN","RAREG3",64,0) I X="NOW" S RADTICHK=9999999.9999-($E($$NOW^XLFDT,1,12)) I $D(^RADPT(RADFN,"DT",RADTICHK,0)) D SUB1MIN K RADTICHK "RTN","RAREG3",65,0) S %DT(0)=-$$FMADD^XLFDT($$NOW^XLFDT,0,RAHRS,0,0),%DT="ETXR" "RTN","RAREG3",66,0) D ^%DT K %DT G DT:Y<0 "RTN","RAREG3",67,0) DT1 S RADTE=Y,RADTI=9999999.9999-RADTE I $D(^RADPT(RADFN,"DT",RADTI,0)) W !,$C(7),"Patient already has exams entered for this date/time.",!,"....use 'Add Exams to Last Visit' option." G DT "RTN","RAREG3",68,0) DT2 K RADTEBAD S RADTEBAD=$O(^RADPT(RADFN,"DT","B",RADTE)) I RADTEBAD[RADTE D SUB1MIN S RADTE=X,RADTI=RADTICHK G DT2 "RTN","RAREG3",69,0) K RADTEBAD "RTN","RAREG3",70,0) I $D(RANOW),$D(RAWARD) S RACAT="INPATIENT" "RTN","RAREG3",71,0) I '$D(RANOW) K RAWARD,RABED,RASER D ^RASERV S:$D(RAWARD) RACAT="INPATIENT" "RTN","RAREG3",72,0) Q "RTN","RAREG3",73,0) SUB1MIN ; subtract 1 minute from NOW to get an unused date/time "RTN","RAREG3",74,0) F RALOOP=1:1 S X=$$FMADD^XLFDT(RADTE,0,0,-RALOOP,0) S RADTICHK=9999999.9999-X Q:'$D(^RADPT(RADFN,"DT",RADTICHK,0)) "RTN","RAREG3",75,0) K RALOOP "RTN","RAREG3",76,0) Q "RTN","RAREG3",77,0) ; "RTN","RAREG3",78,0) LABEL ; *** Print labels "RTN","RAREG3",79,0) I $D(RAPX) D "RTN","RAREG3",80,0) . W ! S RAPX=RADFN,RAZIS=1 "RTN","RAREG3",81,0) . S RASAV2=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),0)) "RTN","RAREG3",82,0) . S RASAV3=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",$S($G(RACNI):RACNI,1:+$O(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",0))),0)) "RTN","RAREG3",83,0) . D FLH^RAFLH K RANUMF "RTN","RAREG3",84,0) . I $P(RAMDV,U,8) D JAC^RAJAC "RTN","RAREG3",85,0) . S RADFN=RAPX K RAZIS "RTN","RAREG3",86,0) . I $P($G(^DIC(195.4,1,"UP")),U,2) D ^RTQ5 "RTN","RAREG3",87,0) . K RAPX "RTN","RAREG3",88,0) . Q "RTN","RAREG3",89,0) Q "RTN","RAREG3",90,0) ; "RTN","RAREG3",91,0) PRNRQ ;Print Request at Registration - P137/KLM "RTN","RAREG3",92,0) I '$D(RAORDS) Q ;no order array "RTN","RAREG3",93,0) N RAJ,RAOIFN,RAILOC,RAION,RAARY,RAIENS "RTN","RAREG3",94,0) S RAJ=0 F S RAJ=$O(RAORDS(RAJ)) Q:RAJ="" D "RTN","RAREG3",95,0) .S RAOIFN=$G(RAORDS(RAJ)) Q:RAOIFN="" "RTN","RAREG3",96,0) .S RAIENS=RADTI_","_RADFN_"," ;P144/KLM "RTN","RAREG3",97,0) .S RAILOC=$$GET1^DIQ(70.02,RAIENS,4,"I") Q:RAILOC="" ;get i-loc from registered exam **changed from order /p144 "RTN","RAREG3",98,0) .S RAION=$$GET1^DIQ(79.1,RAILOC,28) Q:RAION="" ;Registered Request printer defined? "RTN","RAREG3",99,0) .;Orders for registered exams may span modalities "RTN","RAREG3",100,0) .;order status is active/registered - build RAARY(DEVICE NAME,ORDER IEN) "RTN","RAREG3",101,0) .I $$GET1^DIQ(75.1,RAOIFN,5,"I")=6 S RAARY(RAION,RAOIFN)="" "RTN","RAREG3",102,0) .;End RAJ loop on RAORDS "RTN","RAREG3",103,0) ;Setup task vars for each reg req device with orders "RTN","RAREG3",104,0) I $D(RAARY) D "RTN","RAREG3",105,0) .S RAION="" F S RAION=$O(RAARY(RAION)) Q:RAION="" D "RTN","RAREG3",106,0) ..N RAORS "RTN","RAREG3",107,0) ..S ZTIO=RAION "RTN","RAREG3",108,0) ..S RAOIFN=0 F S RAOIFN=$O(RAARY(RAION,RAOIFN)) Q:RAOIFN="" D "RTN","RAREG3",109,0) ...S RAORS(RAOIFN)="" "RTN","RAREG3",110,0) ...;End RAOIFN loop - Order IEN "RTN","RAREG3",111,0) ..S ZTDESC="Rad/Nuc Med Registered Request Print" "RTN","RAREG3",112,0) ..S ZTDTH=$H,ZTRTN="PRNRQ1^RAREG3" "RTN","RAREG3",113,0) ..S ZTSAVE("RADFN")="",ZTSAVE("RAORS(")="" D ^%ZTLOAD "RTN","RAREG3",114,0) ..K ZTIO,ZTDTH,ZTSAVE,ZTDESC,ZTRTN "RTN","RAREG3",115,0) ..I $D(ZTSK) W !!,"Task "_ZTSK_": registered request(s) queued to print on device ",RAION,! "RTN","RAREG3",116,0) ..;End RAION loop - Device Name "RTN","RAREG3",117,0) .;End RAARY "RTN","RAREG3",118,0) K RAORS,RAION,RAJ,RAILOC,RAARY,RAOIFN "RTN","RAREG3",119,0) Q "RTN","RAREG3",120,0) PRNRQ1 ;task entry point - P137 "RTN","RAREG3",121,0) N RAPAGE,RAX,RAOIFN "RTN","RAREG3",122,0) S RAPAGE=0,RAX="" ;needed for ^RAORD5 "RTN","RAREG3",123,0) S RAOIFN=0 F S RAOIFN=$O(RAORS(RAOIFN)) Q:RAOIFN="" D "RTN","RAREG3",124,0) .U IO D ^RAORD5 "RTN","RAREG3",125,0) K RAPAGE,RAX,RAOIFN "RTN","RAREG3",126,0) Q "RTN","RASTED") 0^3^B54897245^B54871068 "RTN","RASTED",1,0) RASTED ;HISC/CAH,FPT,GJC,SS AISC/TMP,TAC,RMO-Edits for status tracking ;12 Feb 2019 12:26 PM "RTN","RASTED",2,0) ;;5.0;Radiology/Nuclear Medicine;**1,10,18,28,45,71,82,99,154**;Mar 16, 1998;Build 1 "RTN","RASTED",3,0) ;last modif by SS for P18 JUN 19,2000 "RTN","RASTED",4,0) ;02/10/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R "RTN","RASTED",5,0) ; *** 'RASTED' is called from the routine; 'CASE^RASTEXT1'. *** "RTN","RASTED",6,0) ;last modification by SS May 12,2000 "RTN","RASTED",7,0) ; "RTN","RASTED",8,0) ;Supported IA #10040 reference to ^SC "RTN","RASTED",9,0) ;Supported IA #1367 reference to LKUP^XPDKEY "RTN","RASTED",10,0) ;Supported IA #2056 reference to GET1^DIQ "RTN","RASTED",11,0) ;Supported IA #10060 reference to ^VA(200 "RTN","RASTED",12,0) S RAL=X F I2=1:1 S X=$P(RAL,",",I2) Q:X="" S RAVW="" W !!,"Case # being tracked: ",X D SEL^RACNLU D:'RACNT KEY D START:RACNT&((X'="^")&(X'="")) "RTN","RASTED",13,0) K RAL,RAI,RAPRI,I2,I3,RAVW,RAEND,RANME,RAPRC,RARPT,RADTE,RADT0,RANEXT,RANXT72,RASK,RACN,RACN0,RADFN,RADUZ,RAPOP,RAST,RAST0,RAFL,RAFST,RAIX,RASSN,RACOMP,X Q "RTN","RASTED",14,0) ;RACOMP defined if [RA STATUS CHANGE] was processed completely "RTN","RASTED",15,0) START F I3=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",I3)=$P(Y,"^",I3) "RTN","RASTED",16,0) I '$D(^RA(72,+RAST,0)) W $C(7),"Invalid status for case #: ",RACN R X:3 Q "RTN","RASTED",17,0) S RAST0=^RA(72,+RAST,0) I $P(RAST0,"^",3)=9 W $C(7),!,"Exam is already complete!!" R X:3 Q "RTN","RASTED",18,0) S X1="" "RTN","RASTED",19,0) I $D(^RA(72,+$P(RAST0,"^",2),0)) S RANEXT=^(0),RASK=$S($D(^(.2)):^(.2),1:""),RANXT72=+$P(RAST0,"^",2) "RTN","RASTED",20,0) NEXT I '$D(RANEXT) S DIC("A")="Enter Next Status: ",DIC="^RA(72,",DIC(0)="AEFQZ",DIC("S")="I $P(^(0),U,3),$P(^(0),U,7)=$O(^RA(79.2,""B"",RAIMGTY,0))" D ^DIC K DIC Q:Y'>0 S RANEXT=Y(0),RASK=$S($D(^RA(72,+Y,.2)):^(.2),1:""),RANXT72=+Y "RTN","RASTED",21,0) I $P(RANEXT,"^")=$P(RAST0,"^") W $C(7),!,"Status has already been set to ",$P(RANEXT,"^") R X:3 Q "RTN","RASTED",22,0) I $$LKUP^XPDKEY(+$P(RANEXT,"^",4))]"",'$D(^XUSEC($$LKUP^XPDKEY(+$P(RANEXT,"^",4)),DUZ)) W $C(7),!,"You are not authorized to change to this status" R X:3 Q "RTN","RASTED",23,0) ; check if next status has order field filled in "RTN","RASTED",24,0) G:$P(RANEXT,U,3)]"" OK2 "RTN","RASTED",25,0) N RANXTIEN,RALINE S RANXTIEN=$P(RAST0,U,2),$P(RALINE,"_",50)="" "RTN","RASTED",26,0) W !!?15,$C(7),RALINE "RTN","RASTED",27,0) W !!?15,$C(7),"Default Next Status (",$P(RANEXT,U),") is *NOT* active.",!?15,$C(7),RALINE,! "RTN","RASTED",28,0) NXT S RANXTIEN=$P(^RA(72,RANXTIEN,0),U,2) "RTN","RASTED",29,0) G:$P($G(^RA(72,+RANXTIEN,0)),U,3)=9 OK0 ;next default status is COMPLETE "RTN","RASTED",30,0) G:RANXTIEN="" BAD ;no next default status pointer "RTN","RASTED",31,0) G:'$D(^RA(72,RANXTIEN,0)) BAD ;no next default status record "RTN","RASTED",32,0) G:$P($G(^RA(72,RANXTIEN,0)),U,3)="" NXT ;no order data, so loop back "RTN","RASTED",33,0) G OK0 "RTN","RASTED",34,0) BAD W !?15,$C(7),RALINE "RTN","RASTED",35,0) W !!?18,$C(7),"There is no valid higher status to advance to.",!?15,$C(7),RALINE "RTN","RASTED",36,0) KEY W !! K DIR S DIR(0)="E",DIR("A")="Press Return key to continue " D ^DIR "RTN","RASTED",37,0) K DIR,DIRUT,DUOUT Q "RTN","RASTED",38,0) OK0 S RANEXT=$G(^RA(72,RANXTIEN,0)),RANXT72=RANXTIEN "RTN","RASTED",39,0) OK1 W !?15,$C(7),RALINE,!!?18,"Next valid status is : ",$P(RANEXT,U),!?15,$C(7),RALINE "RTN","RASTED",40,0) OK2 S RADT0=^RADPT(RADFN,"DT",RADTI,0),RACN0=^("P",RACNI,0),RACS=$P(RACN0,"^",24),RAPRIT=$P(RACN0,"^",2) "RTN","RASTED",41,0) CHANGE W !!,"Name: ",RANME,?40,"Case # : ",RACN,!,"Division : ",$S($D(^DIC(4,+$P(RADT0,"^",3),0)):$P(^(0),"^"),1:"") "RTN","RASTED",42,0) W ?40,"Location: ",$S('$D(^RA(79.1,+$P(RADT0,"^",4),0)):"",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"") "RTN","RASTED",43,0) W !,"Procedure: ",RAPRC "RTN","RASTED",44,0) D PRCCPT^RAPROD "RTN","RASTED",45,0) ;p99: get sex and display pregnancy data if available for female pt. "RTN","RASTED",46,0) I $$PTSEX^RAUTL8(RADFN)="F" D "RTN","RASTED",47,0) .N RAORD0,RAPCOMM S RAORD0=$P(RACN0,U,11) "RTN","RASTED",48,0) .S RAPCOMM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCOMM")) "RTN","RASTED",49,0) .W !,"PREGNANT AT TIME OF ORDER ENTRY: ",?22,$$GET1^DIQ(75.1,RAORD0_",",13) "RTN","RASTED",50,0) .W:$P(RACN0,U,32)'="" !,"PREGNANCY SCREEN: ",$S($P(RACN0,"^",32)="y":"Patient answered yes",$P(RACN0,"^",32)="n":"Patient answered no",$P(RACN0,"^",32)="u":"Patient is unable to answer or is unsure",1:"") "RTN","RASTED",51,0) .W:$P(RACN0,U,32)'="n"&$L(RAPCOMM) !,"PREGNANCY SCREEN COMMENT: ",RAPCOMM "RTN","RASTED",52,0) ;end p99 "RTN","RASTED",53,0) W !," ***** Old Status: ",$P(RAST0,"^"),!," ***** New Status: ",$P(RANEXT,"^") "RTN","RASTED",54,0) I RAPRC="Unknown" W !!?5,$C(7),"This record is corrupted -- the procedure is missing,",!?5,"please contact your ADPAC or IRM",! K DIR S DIR(0)="E",DIR("A")="Press RETURN to Continue" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT Q "RTN","RASTED",55,0) ASK R !,"Do you wish to continue? YES// ",X1:DTIME S:X1="" X1="Y" Q:'$T!(X1["^")!("nN"[X1) "RTN","RASTED",56,0) I X1["?" W !!,"Answer 'Yes' or 'No'.",! G ASK "RTN","RASTED",57,0) S RADUZ=DUZ I '$P(RAMDV,"^",6)!($P(RASK,"^",11)["Y") S RAPOP=0 D USER Q:RAPOP "RTN","RASTED",58,0) N RAPRTSET,RAMEMARR D EN2^RAUTL20(.RAMEMARR) ;is this a print set ? "RTN","RASTED",59,0) N RAWHICH,RAREM,RABEFORE,RAAFTER "RTN","RASTED",60,0) S DIE("NO^")="BACKOUTOK",DR="[RA STATUS CHANGE]" "RTN","RASTED",61,0) S DA=RADFN,RADADA=RADTI,DIE="^RADPT(",RADIE="^RADPT("_RADFN_",""DT""," "RTN","RASTED",62,0) S RAXIT=$$LOCK^RAUTL12(RADIE,RADADA) Q:RAXIT "RTN","RASTED",63,0) ; "RTN","RASTED",64,0) ;save 'before' CM data value to compare against the possible 'after' "RTN","RASTED",65,0) ;value "RTN","RASTED",66,0) D TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB) ;RA*5*45 "RTN","RASTED",67,0) ; "RTN","RASTED",68,0) D SVBEFOR^RAO7XX(RADFN,RADTI,RACNI) ;P18 save before edit to compare later "RTN","RASTED",69,0) K RACOMP D ^DIE "RTN","RASTED",70,0) ;P18. $D(RABEFORE)=0 means that RASTREQ was not run - the user has interrupted input or timeout happened. So we must call it, then check result (is status changed) and if so - update 70.03 #3 and set RA70033=X "RTN","RASTED",71,0) ;P154 Removed status update from RA STATUS CHANGE template - $D(RABEFORE) check no longer needed. Do update here every time. "RTN","RASTED",72,0) K DA S X=RANXT72 D:X ^RASTREQ I $D(X)#2 S RA70033=X D U70033^RADD3(RADFN,RADTI,RACNI,X) "RTN","RASTED",73,0) ; "RTN","RASTED",74,0) ;1) check data consistency between 'CONTRAST MEDIA USED' & 'CONTRAST "RTN","RASTED",75,0) ;MEDIA' "RTN","RASTED",76,0) ;2) check 'before' CM data against 'after' CM data, file in audit log "RTN","RASTED",77,0) ;if necessary. Remember, contrast media asked when in input template: "RTN","RASTED",78,0) ;RA EXAM EDIT (RA*5*45) "RTN","RASTED",79,0) S RACMDA=RACNI,RACMDA(1)=RADTI,RACMDA(2)=RADFN "RTN","RASTED",80,0) D XCMINTEG^RAMAINU1(.RACMDA) ;1 "RTN","RASTED",81,0) D TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB) ;2 "RTN","RASTED",82,0) K RACMDA,RAOPRC "RTN","RASTED",83,0) ; "RTN","RASTED",84,0) K DIE("NO^"),DQ,DE,RATRKCMB,RAZCM "RTN","RASTED",85,0) K RANM702,RADIOPH,RADOSE,RAIEN702,RAHI,RALOW,RAPRI,RAMIS,RAI,RAPSDRUG,RAR1 "RTN","RASTED",86,0) ; "RTN","RASTED",87,0) ; if EXAM STATUS didn't process, still go thru status-change-logic "RTN","RASTED",88,0) ; variables "RTN","RASTED",89,0) ; --------- "RTN","RASTED",90,0) ; RA70033: is set in the RA STATUS CHANGE input template after the "RTN","RASTED",91,0) ; update to the EXAMINATION STATUS field (70.03;3) "RTN","RASTED",92,0) ; RATCXX: are technologist comments (if any) input by the user "RTN","RASTED",93,0) ; RAMDV: division parameters, piece 10; store the date/time "RTN","RASTED",94,0) ; of an exam status change (1 for yes, 0 for no) "RTN","RASTED",95,0) ; "RTN","RASTED",96,0) D:$D(RA70033)&($P(RAMDV,"^",10)) X7005^RADD3(RADFN,RADTI,RACNI,RAMDV,"",RA70033,$S($D(RADUZ):RADUZ,1:DUZ)) "RTN","RASTED",97,0) D A7007^RADD3(RADFN,RADTI,RACNI,$S($D(RADUZ):RADUZ,1:DUZ),$G(RATCXX)) "RTN","RASTED",98,0) D UNLOCK^RAUTL12(RADIE,RADADA) K RADADA,RADIE "RTN","RASTED",99,0) K RA70033,RADUZ,RATCXX "RTN","RASTED",100,0) N RACN0A ; updated version of the exam node after status updates "RTN","RASTED",101,0) W !,"...Status ",$S($D(RAAFTER)&($G(RABEFORE)=$G(RAAFTER)):"unchanged",$G(RABEFORE)>$G(RAAFTER):"backed down",1:"successfully changed")," for case #: ",RACN "RTN","RASTED",102,0) ; "RTN","RASTED",103,0) ;02/10/2006 BAY/KAM RA*5*71 ,modified in RA*5*82... "RTN","RASTED",104,0) I $D(RAAFTER),$G(RABEFORE)=$G(RAAFTER) R X:3 D Q ;exit if no change "RTN","RASTED",105,0) .;Modified for RA*5*82 "RTN","RASTED",106,0) .N RAEXEDT S RAEXEDT=$$CMPAFTR^RAO7XX(1) ;;P18 compares if procedure was changed sends XX message "RTN","RASTED",107,0) .D:RAEXEDT EXM^RAHLRPC ;P18 compares if procedure was changed sends XX message "RTN","RASTED",108,0) ; "RTN","RASTED",109,0) ; if status got backed down, RANEXT is re-defined inside rtn RASTREQ "RTN","RASTED",110,0) ; when the above edit template gets to the EXAM STATUS field "RTN","RASTED",111,0) ; "RTN","RASTED",112,0) D ^RAORDC I +$P(RANEXT,"^",3)>1,RACS'="Y",$S($P(RACN0,"^",6)']"":1,$P(^DIC(42,+$P(RACN0,"^",6),0),U,3)="D":1,1:0) D EN^RAUTL0 "RTN","RASTED",113,0) S RACN0A=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; updated 0 node! "RTN","RASTED",114,0) ; Do we need to 'Generate Exam Alert' based on the exam status? "RTN","RASTED",115,0) I $D(^RA(72,+$P(RACN0A,"^",3),"ALERT")),($P(^("ALERT"),"^")="y") D "RTN","RASTED",116,0) . ; fire off the 'Rad Patient Examined' alert. "RTN","RASTED",117,0) . N RAPRIT,RAORDIFN "RTN","RASTED",118,0) . S RAPRIT=+$P(RACN0A,"^",2) ; possible call to OERR3^RAORDU1 "RTN","RASTED",119,0) . S RAORDIFN=+$P(RACN0A,"^",11) ; possible call to OERR^RAORDU1 "RTN","RASTED",120,0) . D:$$ORVR^RAORDU()=2.5 OERR^RAUTL1 "RTN","RASTED",121,0) . D:$$ORVR^RAORDU()'<3 OERR3^RAUTL1 "RTN","RASTED",122,0) . Q "RTN","RASTED",123,0) ; "RTN","RASTED",124,0) R X:3 D "RTN","RASTED",125,0) .N RAEXEDT S RAEXEDT=$$CMPAFTR^RAO7XX(1) "RTN","RASTED",126,0) .D EXM^RAHLRPC "RTN","RASTED",127,0) ;P18 compares -if procedure was changed - sends XX message "RTN","RASTED",128,0) Q "RTN","RASTED",129,0) USER S %="A",%DUZ=DUZ W ! D ^XUVERIFY G USERQ:%=-1 I %'=1 W $C(7)," ??" G USER "RTN","RASTED",130,0) Q "RTN","RASTED",131,0) USERQ K RADUZ S RAPOP=1 Q "RTN","RASTED",132,0) WHY1 ;explain why prim/sec resid/staff, diagnoses prompts are skipped "RTN","RASTED",133,0) Q:$G(DA)<1!($G(DA(1))<1)!($G(DA(2))<1) "RTN","RASTED",134,0) N RA0,RA1,RA2,RA5 N:'$D(RA3)#2 RA3 N:'$D(RA4)#2 RA4 "RTN","RASTED",135,0) S RA0=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0)) Q:'RA0 S RA2=0 "RTN","RASTED",136,0) I $G(RA3)=13 D WHY11 G WHYMSG ;diagnoses "RTN","RASTED",137,0) S RA3=12,RA4=70 D WHY11 ;residents "RTN","RASTED",138,0) S RA3=15,RA4=60 D WHY11 ;staff "RTN","RASTED",139,0) WHYMSG W:'RA2 !!?12,"No data have been entered for ",$S(RA3'=13:"residents/staff",1:"diagnoses")," yet.",! "RTN","RASTED",140,0) WHYMSG2 W !?12,$C(7),"The selected case belongs to a print set,",!?12,"Please use the 'Report Enter/Edit' option",!?12,"to enter data for ",$S(RA3=99:"residents/staff/diagnoses",RA3'=13:"residents/staff",1:"diagnoses"),".",!! "RTN","RASTED",141,0) Q "RTN","RASTED",142,0) WHY11 Q:'+$P(RA0,"^",RA3) "RTN","RASTED",143,0) S RA2=1 W !!?2,$P(^DD(70.03,RA3,0),"^")," :",?35 "RTN","RASTED",144,0) W:RA3'=13 $P(^VA(200,+$P(RA0,"^",RA3),0),"^") W:RA3=13 $P(^RA(78.3,+$P(RA0,"^",RA3),0),"^") W ! "RTN","RASTED",145,0) S RA5=$P($P(^DD(70.03,RA4,0),"^",4),";") Q:'$O(^RADPT(DA(2),"DT",DA(1),"P",DA,RA5,0)) "RTN","RASTED",146,0) S RA1=0 W !?4,$P(^DD(70.03,RA4,0),"^")," :" "RTN","RASTED",147,0) F S RA1=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,RA5,RA1)) Q:'RA1 I +^(RA1,0) W ?37 W:RA3'=13 $P($G(^VA(200,+^(0),0)),"^") W:RA3=13 $P($G(^RA(78.3,+^(0),0)),"^") W ! "RTN","RASTED",148,0) Q "RTN","RASTED",149,0) WHY2 ;explain why diags prompts are skipped "RTN","RASTED",150,0) N RA3 S RA3=13,RA4=13.1 G WHY1 "VER") 8.0^22.2 "^DD",71.11,71.11,9,0) CPT CODE^P81'X^ICPT(^0;9^D CPTCHK^RADD1(+$G(Y)) Q "^DD",71.11,71.11,9,3) Enter the appropriate CPT for this procedure. "^DD",71.11,71.11,9,21,0) ^^4^4^3161018^ "^DD",71.11,71.11,9,21,1,0) This field contains the CPT code (must be a "^DD",71.11,71.11,9,21,2,0) number) for this procedure. All CPT (Current "^DD",71.11,71.11,9,21,3,0) Procedural Terminology) codes are issued by the "^DD",71.11,71.11,9,21,4,0) AMA. The CPT File is the responsibility of MAS. "^DD",71.11,71.11,9,"DT") 3190131 "BLD",10671,6) ^138 **END** **END**