Released RA*5*65 SEQ #79 Extracted from mail message **KIDS**:RA*5.0*65^ **INSTALL NAME** RA*5.0*65 "BLD",5857,0) RA*5.0*65^RADIOLOGY/NUCLEAR MEDICINE^0^3080229^y "BLD",5857,1,0) ^^2^2^3080219^^^^ "BLD",5857,1,1,0) Radiology Incorporates Pharmacy APIs. Please see the patch description "BLD",5857,1,2,0) of this patch on FORUM for details. "BLD",5857,4,0) ^9.64PA^71.9^4 "BLD",5857,4,70,0) 70 "BLD",5857,4,70,2,0) ^9.641^70.15^1 "BLD",5857,4,70,2,70.15,0) MEDICATIONS (sub-file) "BLD",5857,4,70,2,70.15,1,0) ^9.6411^.01^1 "BLD",5857,4,70,2,70.15,1,.01,0) MED ADMINISTERED "BLD",5857,4,70,222) y^n^p^^^^n^^n "BLD",5857,4,70,224) "BLD",5857,4,70.2,0) 70.2 "BLD",5857,4,70.2,2,0) ^9.641^70.21^1 "BLD",5857,4,70.2,2,70.21,0) RADIOPHARMACEUTICALS (sub-file) "BLD",5857,4,70.2,2,70.21,1,0) ^9.6411^.01^1 "BLD",5857,4,70.2,2,70.21,1,.01,0) RADIOPHARMACEUTICAL "BLD",5857,4,70.2,222) y^n^p^^^^n^^n "BLD",5857,4,70.2,224) "BLD",5857,4,71,0) 71 "BLD",5857,4,71,2,0) ^9.641^71.055^2 "BLD",5857,4,71,2,71.055,0) DEFAULT MEDICATIONS (sub-file) "BLD",5857,4,71,2,71.055,1,0) ^9.6411^.01^1 "BLD",5857,4,71,2,71.055,1,.01,0) DEFAULT MEDICATION "BLD",5857,4,71,2,71.08,0) DEFAULT RADIOPHARMACEUTICALS (sub-file) "BLD",5857,4,71,2,71.08,1,0) ^9.6411^.01^1 "BLD",5857,4,71,2,71.08,1,.01,0) DEFAULT RADIOPHARMACEUTICAL "BLD",5857,4,71,222) y^n^p^^^^n^^n "BLD",5857,4,71,224) "BLD",5857,4,71.9,0) 71.9 "BLD",5857,4,71.9,2,0) ^9.641^71.9^1 "BLD",5857,4,71.9,2,71.9,0) RADIOPHARMACEUTICAL LOT (File-top level) "BLD",5857,4,71.9,2,71.9,1,0) ^9.6411^5^1 "BLD",5857,4,71.9,2,71.9,1,5,0) RADIOPHARM "BLD",5857,4,71.9,222) y^n^p^^^^n^^n "BLD",5857,4,71.9,224) "BLD",5857,4,"APDD",70,70.15) "BLD",5857,4,"APDD",70,70.15,.01) "BLD",5857,4,"APDD",70.2,70.21) "BLD",5857,4,"APDD",70.2,70.21,.01) "BLD",5857,4,"APDD",71,71.055) "BLD",5857,4,"APDD",71,71.055,.01) "BLD",5857,4,"APDD",71,71.08) "BLD",5857,4,"APDD",71,71.08,.01) "BLD",5857,4,"APDD",71.9,71.9) "BLD",5857,4,"APDD",71.9,71.9,5) "BLD",5857,4,"B",70,70) "BLD",5857,4,"B",70.2,70.2) "BLD",5857,4,"B",71,71) "BLD",5857,4,"B",71.9,71.9) "BLD",5857,6.3) 8 "BLD",5857,"INIT") RA65PST "BLD",5857,"KRN",0) ^9.67PA^8989.52^19 "BLD",5857,"KRN",.4,0) .4 "BLD",5857,"KRN",.4,"NM",0) ^9.68A^1^1 "BLD",5857,"KRN",.4,"NM",1,0) RA PROCEDURE LIST FILE #71^71^0 "BLD",5857,"KRN",.4,"NM","B","RA PROCEDURE LIST FILE #71",1) "BLD",5857,"KRN",.401,0) .401 "BLD",5857,"KRN",.402,0) .402 "BLD",5857,"KRN",.402,"NM",0) ^9.68A^4^3 "BLD",5857,"KRN",.402,"NM",1,0) RA STATUS CHANGE FILE #70^70^0 "BLD",5857,"KRN",.402,"NM",3,0) RA EXAM EDIT FILE #70^70^0 "BLD",5857,"KRN",.402,"NM",4,0) RA PROCEDURE EDIT FILE #71^71^0 "BLD",5857,"KRN",.402,"NM","B","RA EXAM EDIT FILE #70",3) "BLD",5857,"KRN",.402,"NM","B","RA PROCEDURE EDIT FILE #71",4) "BLD",5857,"KRN",.402,"NM","B","RA STATUS CHANGE FILE #70",1) "BLD",5857,"KRN",.403,0) .403 "BLD",5857,"KRN",.5,0) .5 "BLD",5857,"KRN",.84,0) .84 "BLD",5857,"KRN",3.6,0) 3.6 "BLD",5857,"KRN",3.8,0) 3.8 "BLD",5857,"KRN",9.2,0) 9.2 "BLD",5857,"KRN",9.8,0) 9.8 "BLD",5857,"KRN",9.8,"NM",0) ^9.68A^15^13 "BLD",5857,"KRN",9.8,"NM",1,0) RADD3^^0^B25368385 "BLD",5857,"KRN",9.8,"NM",2,0) RADD4^^0^B2279618 "BLD",5857,"KRN",9.8,"NM",3,0) RADOSTIK^^0^B23645905 "BLD",5857,"KRN",9.8,"NM",4,0) RANMUSE2^^0^B37954161 "BLD",5857,"KRN",9.8,"NM",5,0) RANMUTL1^^0^B14346054 "BLD",5857,"KRN",9.8,"NM",6,0) RAMAIN2^^0^B53609974 "BLD",5857,"KRN",9.8,"NM",8,0) RAPSAPI^^0^B19025307 "BLD",5857,"KRN",9.8,"NM",9,0) RANMED1^^0^B11414707 "BLD",5857,"KRN",9.8,"NM",10,0) RAPSAPI2^^0^B40591298 "BLD",5857,"KRN",9.8,"NM",11,0) RANMUSE3^^0^B15377223 "BLD",5857,"KRN",9.8,"NM",12,0) RADD1^^0^B18784553 "BLD",5857,"KRN",9.8,"NM",14,0) RASTREQN^^0^B32502575 "BLD",5857,"KRN",9.8,"NM",15,0) RAPSAPI3^^0^B59625794 "BLD",5857,"KRN",9.8,"NM","B","RADD1",12) "BLD",5857,"KRN",9.8,"NM","B","RADD3",1) "BLD",5857,"KRN",9.8,"NM","B","RADD4",2) "BLD",5857,"KRN",9.8,"NM","B","RADOSTIK",3) "BLD",5857,"KRN",9.8,"NM","B","RAMAIN2",6) "BLD",5857,"KRN",9.8,"NM","B","RANMED1",9) "BLD",5857,"KRN",9.8,"NM","B","RANMUSE2",4) "BLD",5857,"KRN",9.8,"NM","B","RANMUSE3",11) "BLD",5857,"KRN",9.8,"NM","B","RANMUTL1",5) "BLD",5857,"KRN",9.8,"NM","B","RAPSAPI",8) "BLD",5857,"KRN",9.8,"NM","B","RAPSAPI2",10) "BLD",5857,"KRN",9.8,"NM","B","RAPSAPI3",15) "BLD",5857,"KRN",9.8,"NM","B","RASTREQN",14) "BLD",5857,"KRN",19,0) 19 "BLD",5857,"KRN",19.1,0) 19.1 "BLD",5857,"KRN",101,0) 101 "BLD",5857,"KRN",409.61,0) 409.61 "BLD",5857,"KRN",771,0) 771 "BLD",5857,"KRN",870,0) 870 "BLD",5857,"KRN",8989.51,0) 8989.51 "BLD",5857,"KRN",8989.52,0) 8989.52 "BLD",5857,"KRN",8994,0) 8994 "BLD",5857,"KRN","B",.4,.4) "BLD",5857,"KRN","B",.401,.401) "BLD",5857,"KRN","B",.402,.402) "BLD",5857,"KRN","B",.403,.403) "BLD",5857,"KRN","B",.5,.5) "BLD",5857,"KRN","B",.84,.84) "BLD",5857,"KRN","B",3.6,3.6) "BLD",5857,"KRN","B",3.8,3.8) "BLD",5857,"KRN","B",9.2,9.2) "BLD",5857,"KRN","B",9.8,9.8) "BLD",5857,"KRN","B",19,19) "BLD",5857,"KRN","B",19.1,19.1) "BLD",5857,"KRN","B",101,101) "BLD",5857,"KRN","B",409.61,409.61) "BLD",5857,"KRN","B",771,771) "BLD",5857,"KRN","B",870,870) "BLD",5857,"KRN","B",8989.51,8989.51) "BLD",5857,"KRN","B",8989.52,8989.52) "BLD",5857,"KRN","B",8994,8994) "BLD",5857,"QDEF") ^^^^^^^^^^YES "BLD",5857,"QUES",0) ^9.62^^ "BLD",5857,"REQB",0) ^9.611^8^6 "BLD",5857,"REQB",1,0) RA*5.0*18^2 "BLD",5857,"REQB",2,0) RA*5.0*40^2 "BLD",5857,"REQB",4,0) PSS*1.0*108^2 "BLD",5857,"REQB",6,0) PSS*1.0*112^2 "BLD",5857,"REQB",7,0) RA*5.0*71^2 "BLD",5857,"REQB",8,0) RA*5.0*10^2 "BLD",5857,"REQB","B","PSS*1.0*108",4) "BLD",5857,"REQB","B","PSS*1.0*112",6) "BLD",5857,"REQB","B","RA*5.0*10",8) "BLD",5857,"REQB","B","RA*5.0*18",1) "BLD",5857,"REQB","B","RA*5.0*40",2) "BLD",5857,"REQB","B","RA*5.0*71",7) "FIA",70) RAD/NUC MED PATIENT "FIA",70,0) ^RADPT( "FIA",70,0,0) 70IP "FIA",70,0,1) y^n^p^^^^n^^n "FIA",70,0,10) "FIA",70,0,11) "FIA",70,0,"RLRO") "FIA",70,0,"VR") 5.0^RA "FIA",70,70) 1 "FIA",70,70.03) 1 "FIA",70,70.03,200) "FIA",70,70.15) 1 "FIA",70,70.15,.01) "FIA",70.2) NUC MED EXAM DATA "FIA",70.2,0) ^RADPTN( "FIA",70.2,0,0) 70.2PIA "FIA",70.2,0,1) y^n^p^^^^n^^n "FIA",70.2,0,10) "FIA",70.2,0,11) "FIA",70.2,0,"RLRO") "FIA",70.2,0,"VR") 5.0^RA "FIA",70.2,70.2) 1 "FIA",70.2,70.2,100) "FIA",70.2,70.21) 1 "FIA",70.2,70.21,.01) "FIA",71) RAD/NUC MED PROCEDURES "FIA",71,0) ^RAMIS(71, "FIA",71,0,0) 71I "FIA",71,0,1) y^n^p^^^^n^^n "FIA",71,0,10) "FIA",71,0,11) "FIA",71,0,"RLRO") "FIA",71,0,"VR") 5.0^RA "FIA",71,71) 1 "FIA",71,71,50) "FIA",71,71,55) "FIA",71,71.055) 1 "FIA",71,71.055,.01) "FIA",71,71.08) 1 "FIA",71,71.08,.01) "FIA",71.9) RADIOPHARMACEUTICAL LOT "FIA",71.9,0) ^RAMIS(71.9, "FIA",71.9,0,0) 71.9I "FIA",71.9,0,1) y^n^p^^^^n^^n "FIA",71.9,0,10) "FIA",71.9,0,11) "FIA",71.9,0,"RLRO") "FIA",71.9,0,"VR") 5.0^RA "FIA",71.9,71.9) 1 "FIA",71.9,71.9,5) "INIT") RA65PST "KRN",.4,335,-1) 0^1 "KRN",.4,335,0) RA PROCEDURE LIST^3060303.1254^^71^^^3071022 "KRN",.4,335,"%D",0) ^.4001^1^1^3020603^^^^ "KRN",.4,335,"%D",1,0) This template is used in the generation of long procedure listings. "KRN",.4,335,"DXS",1,9.2) S I(1,0)=$G(D1),I(0,0)=$G(D0),DIP(1)=$S($D(^RAMIS(71,D0,"DCM",D1,0)):^(0),1:""),D0=$P(DIP(1),U,1) S:'D0!'$D(^DIC(81.3,+D0,0)) D0=-1 S DIP(101)=$S($D(^DIC(81.3,D0,0)):^(0),1:"") "KRN",.4,335,"DXS",2,9) W:$D(RADIO(0)) !?5,"Default Radiopharmaceutical: ",?39,$$EN1^RAPSAPI(+$P(RADIO(0),"^"),.01) "KRN",.4,335,"DXS",3,9) W:$D(RADIO(0)) !?5," Dflt Administration Route : ",?39,$$GET1^DIQ(71.6,+$P(RADIO(0),"^",3)_",",.01) "KRN",.4,335,"DXS",4,9) W:$D(RADIO(0)) !?5," Dflt Administration Site : ",?39,$$GET1^DIQ(71.7,+$P(RADIO(0),"^",4)_",",.01) "KRN",.4,335,"DXS",5,9) W:$D(RADIO(0)) !?5," Default Form : ",?39,$$GET1^DIQ(71.08,D1_","_D0_",",7) "KRN",.4,335,"DXS",6,9) W:$D(RAPHARM(0)) !?5,"Default Medication : ",?39,$$EN1^RAPSAPI(+$P(RAPHARM(0),"^"),.01) "KRN",.4,335,"DXS",7,9) S RA1=0 F S RA1=$O(^RAMIS(71,D0,"MDL",RA1)) Q:'RA1 S RA2=+^(RA1,0) W ?39,$P(^RAMIS(73.1,RA2,0),U),?44,$P(^(0),U,2) W:$O(^RAMIS(71,D0,"MDL",RA1)) !," " "KRN",.4,335,"F",1) "KRN",.4,335,"F",2) S:$P($G(^RA(79.2,+$P($G(^RAMIS(71,D0,0)),"^",12),0)),"^",5)="Y" RADIO="";"";Z;"S:$P($G(^RA(79.2,+$P($G(^RAMIS(71,D0,0)),"^",12),0)),"^",5)="Y" RADIO="""~ "KRN",.4,335,"F",3) 9;C1~.01;C10;"PROCEDURE / CPT MODIFIER";L30~ "KRN",.4,335,"F",4) 175,S DIP(1)=$S($D(^RAMIS(71,D0,2,D1,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=X W X K DIP;C45;X;Z;"INTERNAL(AMIS CODE)"~175,"-";C48;X~175,.01;C50;L30~ "KRN",.4,335,"F",5) 175,2;C85;"MULTIPLIER"~175,3;C100;"BILATERAL"~175,4;C115;"CT HEAD/BODY"~135,.01;C7;""~135,"(";C10~ "KRN",.4,335,"F",6) 135,X DXS(1,9.2) S X=$P(DIP(101),U,2),DIP(102)=$G(X) S X=" ",X=$P(DIP(102),X) S D0=I(0,0) S D1=I(1,0) W X K DIP;C11;"";Z;"$P(.01:NAME," ")"~135,")";X~ "KRN",.4,335,"F",7) W !!?5,"Type of Procedure : ";X;Z;"W !!?5,"Type of Procedure : ""~6;C40;""~ "KRN",.4,335,"F",8) D:+$O(^RAMIS(71,D0,"CM",0)) CMDISP^RAMAINP1(D0);"";Z;"D:+$O(^RAMIS(71,D0,"CM",0)) CMDISP^RAMAINP1(D0)"~ "KRN",.4,335,"F",9) W !?5,"Required Flash Card Printer: ";X;"";Z;"W !?5,"Required Flash Card Printer: ""~3;C40;""~ "KRN",.4,335,"F",10) W !?5,"Required Flash Card Format : ";X;Z;"W !?5,"Required Flash Card Format : ""~4;C40;""~ "KRN",.4,335,"F",11) W !?5,"Cost of Procedure : ";X;Z;"W !?5,"Cost of Procedure : ""~10;C40;L10;""~ "KRN",.4,335,"F",12) W !?5,"Health Summary With Request: ";X;Z;"W !?5,"Health Summary With Request: ""~13;C40;""~ "KRN",.4,335,"F",13) W !?5,"Staff Review of Reports Req: ";X;Z;"W !?5,"Staff Review of Reports Req: ""~7;C40;""~ "KRN",.4,335,"F",14) W !?5,"Rad Approval of Request Req: ";X;Z;"W !?5,"Rad Approval of Request Req: ""~11;C40;""~ "KRN",.4,335,"F",15) W !?5,"Type of Imaging : ";X;Z;"W !?5,"Type of Imaging : ""~12;C40;""~ "KRN",.4,335,"F",16) W:$D(RADIO) !?5,"Ask Radiopharmaceutical : ";X;Z;"W:$D(RADIO) !?5,"Ask Radiopharmaceutical : ""~ "KRN",.4,335,"F",17) W:$D(RADIO) ?39,$$GET1^DIQ(71,D0_",",2);X;Z;"W:$D(RADIO) ?39,$$GET1^DIQ(71,D0_",",2)"~ "KRN",.4,335,"F",18) W:$D(RADIO) !?5,"Prompt for Radiopharm RX : ";X;Z;"W:$D(RADIO) !?5,"Prompt for Radiopharm RX : ""~ "KRN",.4,335,"F",19) W:$D(RADIO) ?39,$$GET1^DIQ(71,D0_",",19);X;Z;"W:$D(RADIO) ?39,$$GET1^DIQ(71,D0_",",19)"~ "KRN",.4,335,"F",20) 50,S:$D(RADIO) RADIO(0)=$G(^RAMIS(71,D0,"NUC",D1,0));"";m;Z;"S:$D(RADIO) RADIO(0)=$G(^RAMIS(71,D0,"NUC",D1,0))"~ "KRN",.4,335,"F",21) 50,X DXS(2,9);X;Z;"W:$D(RADIO(0)) !?5,"Default Radiopharmaceutical: ",?39,$$EN1^RAPSAPI(+$P(RADIO(0),"^"),.01)"~ "KRN",.4,335,"F",22) 50,W:$D(RADIO(0)) !?5," Usual Dose : ",?39,$P(RADIO(0),"^",2);X;Z;"W:$D(RADIO(0)) !?5," Usual Dose : ",?39,$P(RADIO(0),"^",2)"~ "KRN",.4,335,"F",23) 50,X DXS(3,9);X;Z;"W:$D(RADIO(0)) !?5," Dflt Administration Route : ",?39,$$GET1^DIQ(71.6,+$P(RADIO(0),"^",3)_",",.01)"~ "KRN",.4,335,"F",24) 50,X DXS(4,9);X;Z;"W:$D(RADIO(0)) !?5," Dflt Administration Site : ",?39,$$GET1^DIQ(71.7,+$P(RADIO(0),"^",4)_",",.01)"~ "KRN",.4,335,"F",25) 50,W:$D(RADIO(0)) !?5," High Adult Dose : ",?39,$P(RADIO(0),"^",5);X;Z;"W:$D(RADIO(0)) !?5," High Adult Dose : ",?39,$P(RADIO(0),"^",5)"~ "KRN",.4,335,"F",26) 50,W:$D(RADIO(0)) !?5," Low Adult Dose : ",?39,$P(RADIO(0),"^",6);X;Z;"W:$D(RADIO(0)) !?5," Low Adult Dose : ",?39,$P(RADIO(0),"^",6)"~ "KRN",.4,335,"F",27) 50,X DXS(5,9);X;Z;"W:$D(RADIO(0)) !?5," Default Form : ",?39,$$GET1^DIQ(71.08,D1_","_D0_",",7)"~ "KRN",.4,335,"F",28) W !?5,"Prompt for Medication? : ",?39,$$GET1^DIQ(71,D0_",",5);X;Z;"W !?5,"Prompt for Medication? : ",?39,$$GET1^DIQ(71,D0_",",5)"~ "KRN",.4,335,"F",29) 55,S RAPHARM(0)=$G(^RAMIS(71,D0,"P",D1,0));"";X;Z;"S RAPHARM(0)=$G(^RAMIS(71,D0,"P",D1,0))"~ "KRN",.4,335,"F",30) 55,X DXS(6,9);X;Z;"W:$D(RAPHARM(0)) !?5,"Default Medication : ",?39,$$EN1^RAPSAPI(+$P(RAPHARM(0),"^"),.01)"~ "KRN",.4,335,"F",31) 55,W:$D(RAPHARM(0)) !?5," Default Dose : ",?39,$P(RAPHARM(0),"^",2);X;Z;"W:$D(RAPHARM(0)) !?5," Default Dose : ",?39,$P(RAPHARM(0),"^",2)"~ "KRN",.4,335,"F",32) W !?5,"Descendents :";"";X;Z;"W !?5,"Descendents :""~300,.01;C40;X~300,S RAZ71=+X;"";Z;"S RAZ71=+X"~ "KRN",.4,335,"F",33) 300,D:+$O(^RAMIS(71,RAZ71,"CM",0)) CMDISP^RAMAINP1(RAZ71);"";Z;"D:+$O(^RAMIS(71,RAZ71,"CM",0)) CMDISP^RAMAINP1(RAZ71)"~ "KRN",.4,335,"F",34) W !?5,"Procedure Message :";X;Z;"W !?5,"Procedure Message :""~200,.01;C40;W35;"";X~"Educational Description :";C6;L28;""~ "KRN",.4,335,"F",35) 500,.01;C40;""~W ?5,"Modality",?32,":";"";Z;"W ?5,"Modality",?32,":""~ "KRN",.4,335,"F",36) X DXS(7,9);"";X;Z;"S RA1=0 F S RA1=$O(^RAMIS(71,D0,"MDL",RA1)) Q:'RA1 S RA2=+^(RA1,0) W ?39,$P(^RAMIS(73.1,RA2,0),U),?44,$P(^(0),U,2) W:$O(^RAMIS(71,D0,"MDL",RA1)) !," ""~ "KRN",.4,335,"F",37) K RAZ71;"";Z;"K RAZ71"~ "KRN",.4,335,"H") Imaging Procedure List "KRN",.402,220,-1) 0^4 "KRN",.402,220,0) RA PROCEDURE EDIT^3070402.1403^^71^^^3080208 "KRN",.402,220,"DIAB",1,1,71.01,0) ALL "KRN",.402,220,"DIAB",1,1,71.0125,0) ALL "KRN",.402,220,"DIAB",1,1,71.0135,0) ALL "KRN",.402,220,"DIAB",1,1,71.04,0) ALL "KRN",.402,220,"DIAB",1,1,71.0731,0) ALL "KRN",.402,220,"DIAB",3,1,71.08,0) LOW ADULT DOSE;T "KRN",.402,220,"DIAB",5,1,71.08,0) HIGH ADULT DOSE;T "KRN",.402,220,"DIAB",6,0,71,10) DISPLAY ED DESC WHEN ORDERED;"DISPLAY EDUCATIONAL DESCRIPTION WHEN ORDERED" "KRN",.402,220,"DIAB",8,1,71.08,0) USUAL DOSE;T "KRN",.402,220,"DR",1,71) S DIE("NO^")="BACKOUTOK";S:$P(^RAMIS(71,DA,0),U,8)="Y" Y="@01";.01;@01;12;S RAIMAG=$$IMAG^RASITE(+X);K RADIO;S:$P($G(^RA(79.2,+$P($G(^RAMIS(71,DA,0)),"^",12),0)),"^",5)="Y" RADIO="";6//BROAD;S RAPTY=$E(X);K DIE("NO^"); "KRN",.402,220,"DR",1,71,1) S:(RAPTY="B")!(RAPTY="P") Y="@7";20//NO;S RAREM="check if user answered 'no' to 'CM Used'" K RAREM;S:$P($G(^RAMIS(71,DA,0)),U,20)="Y" Y="@5";N RADELCMQ S RAREM="if 'no' or null to 'CM Used' kill CM data" K RAREM; "KRN",.402,220,"DR",1,71,2) S:+$O(^RAMIS(71,DA,"CM",0))=0 Y="@6";S RADELCMQ=$$DELCM^RAUTL2(DA);S:$G(RADELCMQ)="^" Y="@999";S:$G(RADELCMQ)="N" Y="@5";K ^RAMIS(71,DA,"CM") S Y="@6";@5;125;@6;731;@7;S:RAPTY'="P" Y="@10";18;@10;13;150;S:"BP"[RAPTY Y="@50";5; "KRN",.402,220,"DR",1,71,3) K RA65 S RA65="P";55///^S X=$$RXMEDIT^RAPSAPI3(.RA65,","_DA_",",71,55,DT);S:$G(RA65("RESULT"))'="" Y="DEFAULT MEDICATIONS";S:'$D(RADIO) Y="@50";@20;W !!?3,"Reminder --"; "KRN",.402,220,"DR",1,71,4) W !!?3,"Selection of 'Suppress' for 'SUPPRESS RADIOPHARM PROMPT' will result in";W !?3,"the deletion of all default radiopharmaceutical information for this";W !?3,"procedure.",!;2;S:X'=1 Y="@40"; "KRN",.402,220,"DR",1,71,5) S:'$O(^RAMIS(71,DA,"NUC",0))&($P(^RAMIS(71,DA,0),U,19)="") Y="@70";W:$O(^RAMIS(71,DA,"NUC",0)) !!?3,"Radiopharmaceutical information entered previously",!?3,"for this procedure will be delete.",$C(7); "KRN",.402,220,"DR",1,71,6) W:$P(^RAMIS(71,DA,0),U,19)]"" !!?3,"PROMPT FOR RADIOPHARM RX will be deleted.",$C(7);S RAASK="" R !!,"Are you sure you want those data deleted ? : N//",RAASK;S:$E(RAASK)=""!("Yy"'[$E(RAASK)) Y="@20"; "KRN",.402,220,"DR",1,71,7) S RAREM="default radiopharms will be deleted from calling rtn RAMAIN2" K RAREM;19///@;S:RAPTY="B" Y="@150";S:RAPTY="P" Y="@200";S Y="@70";@40;19;@50;S:RAPTY="B" Y="@150";S:RAPTY="P" Y="@200";S:'$D(RADIO) Y="@70";K RA65 S RA65="R"; "KRN",.402,220,"DR",1,71,8) 50///^S X=$$RXMEDIT^RAPSAPI3(.RA65,","_DA_",",71,50,DT);S:$G(RA65("RESULT"))'="" Y="DEFAULT RADIOPHARMACEUTICALS";@70;175;S RAREM="edit CPT for new records only RAPNM=proc. name" K RAREM;S:'RANEW71 Y="@15";D CPT^RAMAINU(DA,RAPNM); "KRN",.402,220,"DR",1,71,9) @15;W:'RANEW71 !,"CPT CODE// "_$P($$NAMCODE^RACPTMSC($P(^RAMIS(71,DA,0),U,9),DT),U)_" (no editing)";D:$T(DISDCM^RACPTMSC)]"" DISDCM^RACPTMSC;135;7//NO;11//NO;@150;3;4;75;@200;S:"BP"'[RAPTY Y="@250";11//NO;@250;200; "KRN",.402,220,"DR",1,71,10) S:RAPTY'="P" Y="@290";300;@290;500;S:'$O(^RAMIS(71,DA,"EDU",0)) Y="@300";17DISPLAY EDUCATIONAL DESCRIPTION WHEN ORDERED~;@300;100//^S X=$S(RAPTY="P"&('$O(^RAMIS(71,DA,4,0))):DT,1:"");@999;K RADIO,RAMIS,RAPTY,RAIMAG,RA65; "KRN",.402,220,"DR",2,71.01) .01 "KRN",.402,220,"DR",2,71.0125) .01 "KRN",.402,220,"DR",2,71.0135) .01 "KRN",.402,220,"DR",2,71.02) .01;2; "KRN",.402,220,"DR",2,71.03) .01;S RAMIS=X;2;S:$P(RAIMAG,U,3)="NM" Y="@99";3;S:RAMIS'=21 Y="@99";4;@99; "KRN",.402,220,"DR",2,71.04) .01 "KRN",.402,220,"DR",2,71.05) .01; "KRN",.402,220,"DR",2,71.055) S:$G(X)="" Y=0;.01///^S X=$$RXMEDIT^RAPSAPI3(.RA65,DA_","_DA(1)_",");2; "KRN",.402,220,"DR",2,71.0731) .01 "KRN",.402,220,"DR",2,71.08) S:$G(X)="" Y=0;.01///^S X=$$RXMEDIT^RAPSAPI3(.RA65,DA_","_DA(1)_",");6T~;S X=X;5T~;S X=X;D EN^DDIOL("Input a 'Usual Dose' value within the range of: "_$$RANGE^RADD2(.DA),"","!?5");2T~;S X=X;3;S RAROUTE=+$G(X); "KRN",.402,220,"DR",2,71.08,1) S:'$O(^RAMIS(71.6,RAROUTE,"SITE",0)) Y="@49";S:$P(^RAMIS(71.6,RAROUTE,0),U,3)="Y" Y="@49";4;S Y="@55";@49;4///@;@55;7; "KRN",.402,230,-1) 0^1 "KRN",.402,230,0) RA STATUS CHANGE^3070416.1057^^70^^^3080207 "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,11) NUCLEAR MED DATA: "KRN",.402,230,"DIAB",1,3,70.09,0) ALL "KRN",.402,230,"DIAB",1,3,70.1,0) ALL "KRN",.402,230,"DIAB",1,3,70.11,0) ALL "KRN",.402,230,"DIAB",1,3,70.12,0) ALL "KRN",.402,230,"DIAB",1,3,70.3135,0) ALL "KRN",.402,230,"DIAB",1,3,70.3225,0) ALL "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,"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:'($P(RASK,"^",7)["Y"&($P(^RAMIS(71,RAPRI,0),"^",5)="y")) Y="@14";K RA65 S RA65="P"; "KRN",.402,230,"DR",3,70.03,9) 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,10) 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,11) ^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,12) S:$O(^RADPTN(+$G(RAIEN702),"NUC",0)) Y="@80";K RAIEN702;500///@;@80;K RA65;3///^S X=$P(RANEXT,"^");S RA70033=X; "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 "KRN",.402,235,-1) 0^3 "KRN",.402,235,0) RA EXAM EDIT^3070416.1112^^70^^^3080227 "KRN",.402,235,"%D",0) ^.4021^1^1^3060123^^^^ "KRN",.402,235,"%D",1,0) This template is used to edit exams. "KRN",.402,235,"DIAB",1,2,70.03,11) NUCLEAR MED DATA: "KRN",.402,235,"DIAB",1,3,70.1,0) ALL "KRN",.402,235,"DIAB",1,3,70.12,0) ALL "KRN",.402,235,"DIAB",1,3,70.3135,0) ALL "KRN",.402,235,"DIAB",1,3,70.3225,0) ALL "KRN",.402,235,"DIAB",1,4,70.21,5) DOSE ADMINISTERED//^S X=RADRAWN;T "KRN",.402,235,"DIAB",2,4,70.21,3) ACTIVITY DRAWN (in mCi);T "KRN",.402,235,"DIAB",3,2,70.03,1) 2;REQ "KRN",.402,235,"DIAB",3,2,70.03,8) CONTRACT/SHARING SOURCE;REQ "KRN",.402,235,"DIAB",6,2,70.03,7) WARD;REQ "KRN",.402,235,"DIAB",6,2,70.03,8) PRINCIPAL CLINIC;REQ "KRN",.402,235,"DIAB",6,4,70.21,6) PRESCRIBED DOSE BY MD OVERRIDE;T "KRN",.402,235,"DIAB",7,2,70.03,7) SERVICE;REQ "KRN",.402,235,"DIAB",8,2,70.03,7) BEDSECTION;REQ "KRN",.402,235,"DIAB",11,2,70.03,7) RESEARCH SOURCE;REQ "KRN",.402,235,"DR",1,70) I '$D(RADTE)!('$D(RACN))!('$D(RAQUICK))!('$D(RAMDV)) W !?3,$C(7),"You must have the variables for 'Case Number','Exam Date' and",!?3,"'Rad/Nuc Med Division' defined to continue!" S Y="@999";S RAPOP=0 D USER^RAUTL S:RAPOP Y="@999"; "KRN",.402,235,"DR",1,70,1) 2///^S X=RADTE;@999;K RAY,RAR,RA0,RACAT,RAI,RAIEN702,RANUZD1; "KRN",.402,235,"DR",2,70.02) 50///^S X=RACN;@800; "KRN",.402,235,"DR",3,70.03) S RAREM="RANUZD1 = case's Img typ's 'Radiopharm Used'";S:$P($G(^RA(79.2,+$P($G(^RADPT(DA(2),"DT",DA(1),0)),"^",2),0)),"^",5)="Y" RANUZD1="";S RAY=^RADPT(DA(2),"DT",DA(1),"P",DA,0) F RAI=1:1:18 S RA0(RAI)=$P(RAY,U,RAI); "KRN",.402,235,"DR",3,70.03,1) S RAR=$S($D(^RADPT(DA(2),"DT",DA(1),"P",DA,"R")):^("R"),1:"");@20;2R~;S RAPRI=+X;S RAREM="did user change the procedure ?";I RAPRI=RA0(2) S Y="@19";S RAREM="if procedures change, make sure CM associations are preserved..."; "KRN",.402,235,"DR",3,70.03,2) D CHGPRC^RAUTL21(RA0(2),RAPRI,.DA);D WARNPRC^RAUTL;I RAWHICH=0 S Y="@19";I RAWHICH=2 S Y="@17";W !,"... Deleting radiopharms ...",!;500///@;@17;I RAWHICH=1 S Y="@19";W !,"... Deleting Medications ...",!; "KRN",.402,235,"DR",3,70.03,3) K ^RADPT(DA(2),"DT",DA(1),"P",DA,"RX");@19;I '$P(RAMDV,U,7)!($P(^RAMIS(71,+RAPRI,0),U,6)'="B") S Y="@21";W !?3,$C(7),"A 'detailed' procedure or a 'series' of procedures is required!";2///@;S Y="@20";@21;S:'$$FUTC^RACPTCSV Y="@20"; "KRN",.402,235,"DR",3,70.03,4) S RAREM="determine if CM is used for this procedure";S RAZCM=$O(^RAMIS(71,RAPRI,"CM","B",""));10//^S X=$S(RAZCM'="":"YES",1:"NO");S RAZCM(0)=X;S:$E(RAZCM(0))="N" Y=$$PRGCM^RAMAINU(.DA); "KRN",.402,235,"DR",3,70.03,5) D:$E(RAZCM(0))="Y"&('+$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))) STUFCM70^RAMAINU(.DA,RAPRI);S X=X;225;D:+$O(^RADPT(DA(2),"DT",DA(1),"P",DA,"CM",0))=0 UPXCM^RAMAINU(.DA,"N");@225;125;@37;D:$T(DISCMOD^RACPTMSC)]"" DISCMOD^RACPTMSC; "KRN",.402,235,"DR",3,70.03,6) 135;S:'$$FUTCMOD^RACPTCSV Y="@37";4;S RACAT=X;S:RA0(4)=RACAT Y="@4";S:RA0(8)']"" Y="@1";8///@;@1;S:RA0(9)']"" Y="@2";9///@;@2;S:RA0(6)']"" Y="@10";6///@;@10;S:RA0(7)']"" Y="@11";7///@;@11;S:$P(RAY,"^",19)']"" Y="@3";19///@;@3; "KRN",.402,235,"DR",3,70.03,7) S:RAR']"" Y="@4";9.5///@;@4;S Y=$S(RACAT="I":"@5",RACAT="E":"@12",RACAT="R":"@6","CS"[RACAT:"@7",1:"@8");@5;6R~;7R~;19R~;S Y="@100";@6;9.5R~;@12;I '$D(VADMVT) S DFN=DA(2),VAINDT=9999999.9999-DA(1) D ADM^VADPT2; "KRN",.402,235,"DR",3,70.03,8) S Y=$S(VADMVT:"@5",1:"@8");@7;9R~;S Y="@100";@8;8R~;@100;14;175;S RATCXX=$$TCPROMPT^RAO7XX;16//^S X=$S($D(^RA(78.1,"B","NO COMPLICATION")):"NO COMPLICATION",1:"");S:'$D(^RA(78.1,+X,0)) Y="@130"; "KRN",.402,235,"DR",3,70.03,9) S:$P(^RA(78.1,+X,0),U)="NO COMPLICATION" Y="@130";16.5;@130;S:'$P(RAMDV,U,9) Y="@140";18;@140;50;@99;S:'$D(RANUZD1) Y="@700";S RAREM="skip radio section if case' Img Typ's 'RADIO...USED' is NEVER"; "KRN",.402,235,"DR",3,70.03,10) S:$P(^RAMIS(71,+RAPRI,0),U,2)=1 Y="@700";S RAIEN702=$$EN1^RANMPT1(RADFN,RADTE,RACN);S:RAIEN702=-1 Y="@700";500////^S X=RAIEN702; "KRN",.402,235,"DR",3,70.03,11) ^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:"");@700;S RA00=$O(^RADPTN("AA",RADFN,RADTE,RACN,0));S:'RA00 Y="@710"; "KRN",.402,235,"DR",3,70.03,12) S:$O(^RADPTN(RA00,"NUC",0)) Y="@710";K RAIEN702;500///@;@710;S RACT=$S(RAQUICK:"C",1:"P");100///^S X="""NOW""";S RAREM="here, DIE is ^RADPT(-,'DT',-,'P',";S RA00=$O(@(DIE_DA_",""RX"","_"0)")); "KRN",.402,235,"DR",3,70.03,13) S RA00=$G(@(DIE_DA_",""RX"","_+RA00_",0)"));S:RA00]"" Y="@720";S RASKMEDS=$P(^RAMIS(71,+RAPRI,0),U,5) S:RASKMEDS=""!("Yy"'[RASKMEDS) Y="@790";@720;K RA65 S RA65="P"; "KRN",.402,235,"DR",3,70.03,14) 200///^S X=$$RXMEDIT^RAPSAPI3(.RA65,","_RACNI_","_RADTI_","_RADFN_",",70.03,200,RADTE);S:$G(RA65("RESULT"))'="" Y="MEDICATIONS";@790;K RA65; "KRN",.402,235,"DR",4,70.04) .01;2; "KRN",.402,235,"DR",4,70.07) 2///^S X=RACT;3////^S X=RADUZ;4///^S X=RATCXX;S:RATCXX'="" Y="@18";4///@;K ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",DA,"TCOM");@18;K RATCXX; "KRN",.402,235,"DR",4,70.1) .01 "KRN",.402,235,"DR",4,70.12) .01 "KRN",.402,235,"DR",4,70.15) S:$G(X)="" Y=0;.01///^S X=$$RXMEDIT^RAPSAPI3(.RA65,DA_","_RACNI_","_RADTI_","_RADFN_",");2;S:$P(RA00,U,3)="" Y="@740";3//^S X="NOW";@740;S:$P(RA00,U,4)="" Y="@750";4//^S X=$P($G(^VA(200,DUZ,0)),"^");@750; "KRN",.402,235,"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,235,"DR",4,70.3135) .01 "KRN",.402,235,"DR",4,70.3225) .01 "KRN",.402,235,"DR",5,70.21) S:$G(X)="" Y=0;.01///^S X=$$RXMEDIT^RAPSAPI3(.RA65,DA_","_DA(1)_",");S RAPSDRUG=X;S:'$G(D0) Y="@500";S RAREM="NOTE: here, DIE is ^RADPTN(D0,'NUC',";S:DIE'[",""NUC""" Y="@500";S RA00=$G(@(DIE_DA_",0)"));S:RA00="" Y="@500";@210; "KRN",.402,235,"DR",5,70.21,1) S RADIOPH=$O(^RAMIS(71,$G(RAPRI),"NUC","B",+$G(RAPSDRUG),0)),(RALOW,RAHI,RADRAWN,RADOSE,RASKMEDS)="";S:'RADIOPH Y="@220";S RADIOPH=$G(^RAMIS(71,$G(RAPRI),"NUC",RADIOPH,0)),RALOW=$P(RADIOPH,U,6),RAHI=$P(RADIOPH,U,5);@220; "KRN",.402,235,"DR",5,70.21,2) S:$P(RA00,U,4)="" Y="@230";@225;W:RAHI]""!(RALOW]"")!($P(RADIOPH,U,2)]"") !! W:RAHI]"" "High Dose :",RAHI_" mCi" W:RALOW]"" ?27,"Low Dose :",RALOW_" mCi" W:$P(RADIOPH,U,2)]"" ?53,"Usual Dose :",$P(RADIOPH,U,2)_" mCi"; "KRN",.402,235,"DR",5,70.21,3) W:RAHI]""!(RALOW]"")!($P(RADIOPH,U,2)]"") !;4T~;S RADRAWN=X;S Y=$$VALDOS^RASTREQN(RALOW,RAHI,RADRAWN,"@225","@230","@999",0);@230;S:$P(RA00,U,5)="" Y="@240";5;@240;S:$P(RA00,U,6)="" Y="@250";6;@250; "KRN",.402,235,"DR",5,70.21,4) W:RAHI]""!(RALOW]"")!($P(RADIOPH,U,2)]"") !! W:RAHI]"" "High Dose: ",RAHI_" mCi" W:RALOW]"" ?27,"Low Dose: ",RALOW_" mCi" W:$P(RADIOPH,U,2)]"" ?53,"Usual Dose: ",$P(RADIOPH,U,2)," mCi";W:RAHI]""!(RALOW]"")!($P(RADIOPH,U,2)]"") !; "KRN",.402,235,"DR",5,70.21,5) 7T~//^S X=RADRAWN;S RADOSE=X;S:RALOW]""&(XRAHI) Y="@255";S Y="@258";@255;D WARN^RANMED1;R !!,"OK to continue (Y/N) ?: N//",RAASK;W !;S RAASK=$E(RAASK);S:"Yy"'[RAASK!(RAASK="") Y="@250"; "KRN",.402,235,"DR",5,70.21,6) S RAREM="is fil 71's PROMPT FOR RADIOPHARM RX yes ?";@258;S RAASK=$P($G(^RAMIS(71,+RAPRI,0)),U,19) S:RAASK=""!("Yy"'[RAASK) Y="@270";@260;3;2T~;@270;8//^S X=$S($P($G(^RADPTN(DA(1),"NUC",DA,0)),"^",5)]"":$P(^(0),"^",5),1:"NOW"); "KRN",.402,235,"DR",5,70.21,7) 9//^S X=$P(^VA(200,+$G(DUZ),0),U);@290;S:$P(RA00,U,6)="" Y="@310";6;@310;S RAREM="Note: 'RAASK' may not be defined, hit global for 'Prompt For Radiopharm RX'";S:$P($G(^RAMIS(71,RAPRI,0)),"^",19)'="y" Y="@320";10;@320; "KRN",.402,235,"DR",5,70.21,8) S:$P(RA00,U,11)="" Y="@330";11;@330;S:$P(RA00,U,12)="" Y="@335";12;@335;S:'$D(@(DIE_DA_",""SITX"")")) Y="@340";12.5;@340;S:$P(RA00,U,13)="" Y="@350";13;@350;S:$P(RA00,U,14)="" Y="@360";14;@360;S:$P(RA00,U,15)="" Y="@500";15;@500; "KRN",.402,235,"ROUOLD") RACTEX "MBREQ") 0 "ORD",5,.4) .4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) "ORD",5,.4,0) PRINT TEMPLATE "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,20,0) ^9.402P^^ "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) 65^3080229 "PKG",18,22,1,"PAH",1,1,0) ^^2^2^3080229 "PKG",18,22,1,"PAH",1,1,1,0) Radiology Incorporates Pharmacy APIs. Please see the patch description "PKG",18,22,1,"PAH",1,1,2,0) of this patch on FORUM for details. "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") 14 "RTN","RA65PST") 0^^B1265156^n/a "RTN","RA65PST",1,0) RA65PST ;HOIFO/SWM-Post install ;1/24/06 13:51 "RTN","RA65PST",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16,1998;Build 8 "RTN","RA65PST",3,0) ;This is the post-install routine for patch RA*5.0*65 "RTN","RA65PST",4,0) ;Supported IA #5122 Remove Rad/Nuc Med dd Screen of Sub field #70.15 "RTN","RA65PST",5,0) ;Supported IA #5123 Remove Rad/Nuc Med dd Screen of Sub field #70.21 "RTN","RA65PST",6,0) ;Supported IA #5124 Remove Rad/Nuc Med dd Screen of Sub field #71.055 "RTN","RA65PST",7,0) ;Supported IA #5125 Remove Rad/Nuc Med dd Screen of Sub field #71.08 "RTN","RA65PST",8,0) ;Supported IA #5126 Remove Rad/Nuc Med dd Screen of File 71.9 field #5 "RTN","RA65PST",9,0) ;Supported IA #5127 Set Rad/Nuc Med data dictionary 'ID','WRIT "RTN","RA65PST",10,0) ;Supported IA #10142 Classic FileMan API: Loader EN^DDIOL "RTN","RA65PST",11,0) ; "RTN","RA65PST",12,0) ;This routine may be deleted after RA*5.0*65 is installed. "RTN","RA65PST",13,0) ; "RTN","RA65PST",14,0) ;1. delete identifier RADIOPHARM from file 71.9 "RTN","RA65PST",15,0) ;2. set Write node so file 71.9 lookup would include RADIOPHARM "RTN","RA65PST",16,0) ;3. remove obsolete ^DD(-,,12) and ^DD(-,,12.1) data screen nodes "RTN","RA65PST",17,0) ; "RTN","RA65PST",18,0) I '$D(XPDNM)#2 D EN^DDIOL("This entry point must be called from the KIDS installation -- Nothing Done.",,"!!,$C(7)") Q "RTN","RA65PST",19,0) ;1. "RTN","RA65PST",20,0) K ^DD(71.9,0,"ID",5) "RTN","RA65PST",21,0) ; "RTN","RA65PST",22,0) ;2. "RTN","RA65PST",23,0) S ^DD(71.9,0,"ID","WRITE")="D EN^DDIOL($$EN5^RAPSAPI,"""",""?30"")" "RTN","RA65PST",24,0) ; "RTN","RA65PST",25,0) ;3. "RTN","RA65PST",26,0) K ^DD(70.15,.01,12),^(12.1) "RTN","RA65PST",27,0) K ^DD(70.21,.01,12),^(12.1) "RTN","RA65PST",28,0) K ^DD(71.055,.01,12),^(12.1) "RTN","RA65PST",29,0) K ^DD(71.08,.01,12),^(12.1) "RTN","RA65PST",30,0) K ^DD(71.9,5,12),^(12.1) "RTN","RA65PST",31,0) Q "RTN","RADD1") 0^12^B18784553^B18291881 "RTN","RADD1",1,0) RADD1 ;HISC/FPT-Radiology Utility Routine ;6/2/98 16:17 "RTN","RADD1",2,0) ;;5.0;Radiology/Nuclear Medicine;**1,5,10,65**;Mar 16, 1998;Build 8 "RTN","RADD1",3,0) ; "RTN","RADD1",4,0) ;Supported IA #10142 reference to EN^DDIOL "RTN","RADD1",5,0) ;Supported IA #10103 reference to FMADD^XLFDT "RTN","RADD1",6,0) ; "RTN","RADD1",7,0) SECXREF ; sets/kills 'ARES' & 'ASTF' x-refs for secondary resident/staff rads "RTN","RADD1",8,0) ; called from ^DD(74,5 "RTN","RADD1",9,0) ; "RTN","RADD1",10,0) Q:'$D(^RARPT(DA,0)) S RADFNZ=^(0) "RTN","RADD1",11,0) S RADTIZ=9999999.9999-$P(RADFNZ,"^",3),RACNIZ=$O(^RADPT(+$P(RADFNZ,"^",2),"DT",RADTIZ,"P","B",+$P(RADFNZ,"^",4),0)),RADFNZ=+$P(RADFNZ,"^",2) "RTN","RADD1",12,0) I 'RACNIZ D KILL Q "RTN","RADD1",13,0) I '$D(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,0)) D KILL Q "RTN","RADD1",14,0) I '$D(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,RASECOND,0)) D KILL Q "RTN","RADD1",15,0) S RASECIEN=0 "RTN","RADD1",16,0) F S RASECIEN=$O(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,RASECOND,RASECIEN)) Q:RASECIEN<1 S RARAD=+$P($G(^(RASECIEN,0)),"^",1) I RARAD>0 D "RTN","RADD1",17,0) .S:$D(RASET) ^RARPT(RAXREF,RARAD,DA)="" K:$D(RAKILL) ^RARPT(RAXREF,RARAD,DA) "RTN","RADD1",18,0) D XSEC^RAUTL20 "RTN","RADD1",19,0) KILL K RACNIZ,RADFNZ,RADTIZ,RASECOND,RASECIEN "RTN","RADD1",20,0) Q "RTN","RADD1",21,0) SCDTC ; status change date/time check "RTN","RADD1",22,0) ; called from ^DD(70.05,.01 "RTN","RADD1",23,0) ; if X is a date/time prior to the exam date/time, then set Y=0. "RTN","RADD1",24,0) ; if X is a over a minute in the future, then set Y=0. "RTN","RADD1",25,0) ; if X is missing the time portion, then set Y=0. "RTN","RADD1",26,0) I '($D(X)#2) Q "RTN","RADD1",27,0) I '$F(X,".") D EN^DDIOL("** Time is Required **","","!!?20") S Y=0 Q "RTN","RADD1",28,0) N RASTATUS,RAORDNUM,RAPLUS1 "RTN","RADD1",29,0) ; eg. da(3)=1128, da(2)=7028970.8743,da(1)=1,da=1 "RTN","RADD1",30,0) S RASTATUS=$P($G(^RADPT(+$G(DA(3)),"DT",+$G(DA(2)),"P",+$G(DA(1)),0)),U,3) "RTN","RADD1",31,0) S RAORDNUM=$P($G(^RA(72,+RASTATUS,0)),U,3) "RTN","RADD1",32,0) I X<(9999999.9999-$G(DA(2))),RAORDNUM>1 S Y=0 Q "RTN","RADD1",33,0) S RADTHOLD=X "RTN","RADD1",34,0) D NOW^%DTC "RTN","RADD1",35,0) ; 2/25/98 allow entry to be at most 1 minute after current time "RTN","RADD1",36,0) S RAPLUS1=%,RAPLUS1=$$FMADD^XLFDT(RAPLUS1,0,0,1,0) "RTN","RADD1",37,0) I RADTHOLD>RAPLUS1 S Y=0 "RTN","RADD1",38,0) S X=RADTHOLD "RTN","RADD1",39,0) K RADTHOLD "RTN","RADD1",40,0) Q "RTN","RADD1",41,0) PDC() ; do not enter secondary into primary diagnostic code field "RTN","RADD1",42,0) ; called from ^DD(70.03,13,0) "RTN","RADD1",43,0) ; do not select inactive diagnostic code 12/23/96 "RTN","RADD1",44,0) I $P(^RA(78.3,+Y,0),U,5)="Y" Q 0 "RTN","RADD1",45,0) I $D(^RADPT(DA(2),"DT",DA(1),"P",DA,"DX","B",+Y)) Q 0 "RTN","RADD1",46,0) Q 1 "RTN","RADD1",47,0) SDC() ; do not enter primary into secondary diagnostic code field "RTN","RADD1",48,0) ; called from ^DD(70.14,.01,0) "RTN","RADD1",49,0) ; do not select inactive diagnostic code 12/23/96 "RTN","RADD1",50,0) I $P(^RA(78.3,+Y,0),U,5)="Y" Q 0 "RTN","RADD1",51,0) I '$D(X)!('$D(DA(3))) G SDC2 "RTN","RADD1",52,0) I '$D(^RADPT(DA(3),"DT",DA(2),"P",DA(1),0)) G SDC2 "RTN","RADD1",53,0) I $P(^RADPT(DA(3),"DT",DA(2),"P",DA(1),0),"^",13)=+Y Q 0 "RTN","RADD1",54,0) Q 1 "RTN","RADD1",55,0) SDC2 ; "RTN","RADD1",56,0) I '$D(X)!('$D(DA(2))) G SDC3 "RTN","RADD1",57,0) I '$D(^RADPT(DA(2),"DT",DA(1),"P",DA,0)) Q 0 "RTN","RADD1",58,0) I $P(^RADPT(DA(2),"DT",DA(1),"P",DA,0),"^",13)=+Y Q 0 "RTN","RADD1",59,0) Q 1 "RTN","RADD1",60,0) SDC3 ; "RTN","RADD1",61,0) I '$D(RADFN) Q 0 "RTN","RADD1",62,0) S DA(2)=RADFN "RTN","RADD1",63,0) I '$D(^RADPT(DA(2),"DT",DA(1),"P",DA,0)) Q 0 "RTN","RADD1",64,0) I $P(^RADPT(DA(2),"DT",DA(1),"P",DA,0),"^",13)=+Y Q 0 "RTN","RADD1",65,0) Q 1 "RTN","RADD1",66,0) NODEL ; no deletion of primary dx code, primary resident or staff if there "RTN","RADD1",67,0) ; is a secondary "RTN","RADD1",68,0) S RASECCHK=0,RASECCHK=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,RAMULT,RASECCHK)) "RTN","RADD1",69,0) I RASECCHK W " Required" "RTN","RADD1",70,0) K RAMULT,RASECCHK "RTN","RADD1",71,0) Q "RTN","RADD1",72,0) PRCCPT() ; Displays the procedure type and CPT code if applicable. "RTN","RADD1",73,0) ; This code is called from ^DD(71,0,"ID","WRITE") and rtn RAPROD "RTN","RADD1",74,0) N RA,RATXT S RA(0)=$G(^(0)),RA("I")=+$G(^("I")),RATXT="" "RTN","RADD1",75,0) S RA=$S('RA("I"):0,DT'>RA("I"):0,1:1) "RTN","RADD1",76,0) S RA(6)=$P(RA(0),U,6),RA(9)=$P(RA(0),U,9) "RTN","RADD1",77,0) S RA(12)=$P(RA(0),U,12) I 'RA(12) S RA(10)="UNKN " "RTN","RADD1",78,0) I '$D(RA(10)) S RA(10)=$P(^RA(79.2,+RA(12),0),U,3)_" " "RTN","RADD1",79,0) I $L(RA(10))<5 F S RA(10)=RA(10)_" " Q:$L(RA(10))>4 "RTN","RADD1",80,0) S RATXT="("_RA(10)_$S(RA:"Inactive",RA(6)="B":"Broad ",RA(6)="D":"Detailed",RA(6)="P":"Parent ",RA(6)="S":"Series ",1:"Unknown ")_")" "RTN","RADD1",81,0) S:RA(9)]"" RATXT=RATXT_" CPT:"_$P($$NAMCODE^RACPTMSC(RA(9),DT),"^") "RTN","RADD1",82,0) Q RATXT "RTN","RADD1",83,0) INDTCHK(RADA) ; Cannot inactivate a procedure if it is a common procedure "RTN","RADD1",84,0) ; with a valid sequence number. Code resides in ^DD(71,100,0)! "RTN","RADD1",85,0) ; 'RADA' is the ien of the procedure in file 71. if this procedure is "RTN","RADD1",86,0) ; a common procedure i.e, $D(^RAMIS(71.3,"B",RADA)) inform the user that "RTN","RADD1",87,0) ; the sequence number must be deleted. This relies on the "AA" xref in "RTN","RADD1",88,0) ; the Common Proc. file for the Sequence # fld (#3) 0 node, 4th pce. "RTN","RADD1",89,0) N RA,RAIEN S RAIEN=+$O(^RAMIS(71.3,"B",RADA,0)) "RTN","RADD1",90,0) S RA(0)=$G(^RAMIS(71.3,RAIEN,0)) Q:RA(0)']"" "RTN","RADD1",91,0) S RA(4)=+$P(RA(0),"^",4) ; obtain the sequence number "RTN","RADD1",92,0) I $D(^RAMIS(71.3,"AA",$$EN3^RAUTL17(RADA),RA(4),RAIEN)) D ; sequence #? "RTN","RADD1",93,0) . N RATXT S RATXT(1)=" " "RTN","RADD1",94,0) . S RATXT(2)=" Cannot inactivate - this procedure is currently in the" "RTN","RADD1",95,0) . S RATXT(3)=" Rad/Nuc Med Common Procedure file with a sequence" "RTN","RADD1",96,0) . S RATXT(4)=" number. Please remove the sequence number thru the" "RTN","RADD1",97,0) . S RATXT(5)=" 'Common Procedure Enter/Edit' option before assigning" "RTN","RADD1",98,0) . S RATXT(6)=" an inactivation date to this procedure." "RTN","RADD1",99,0) . S RATXT(7)=" " "RTN","RADD1",100,0) . D EN^DDIOL(.RATXT) K X ; display message, can't input ANY date! "RTN","RADD1",101,0) . Q "RTN","RADD1",102,0) Q "RTN","RADD1",103,0) CPTCHK(RADA) ; Check if the CPT code is inactive nationally. "RTN","RADD1",104,0) ; 'RADA' assume the value of +Y passed from the input xform, ^DD(71,9,0) "RTN","RADD1",105,0) ; quit if CPT code is active "RTN","RADD1",106,0) ; "RTN","RADD1",107,0) Q:$$ACTCODE^RACPTMSC(RADA,DT) "RTN","RADD1",108,0) N RATXT S RATXT(1)=" " "RTN","RADD1",109,0) S RATXT(2)=" Warning - Nationally inactive CPT code." "RTN","RADD1",110,0) S RATXT(3)=" " D EN^DDIOL(.RATXT) "RTN","RADD1",111,0) K X "RTN","RADD1",112,0) Q "RTN","RADD1",113,0) ; "RTN","RADD1",114,0) VALADM(RAD0,Y,RADT,RAUTH) ;edit validation "RTN","RADD1",115,0) ;Used to validate/screen radiopharm dosage administrator, "RTN","RADD1",116,0) ; radiopharm prescribing phys, person who measured radiopharm dose, "RTN","RADD1",117,0) ;---------------------------------------------------------------------- "RTN","RADD1",118,0) ; RAD0 : IEN of entry in question for NUC MED EXAM DATA (70.2) file "RTN","RADD1",119,0) ; Y : Pointer to the New Person file "RTN","RADD1",120,0) ; RADT : Xam Date; if not passed, calculate exam date from file 70.2 "RTN","RADD1",121,0) ; RAUTH : 1 - only staff/resid, must be auth'zd to write med orders "RTN","RADD1",122,0) ; : 0 - staff/resid & tech's "RTN","RADD1",123,0) ;---------------------------------------------------------------------- "RTN","RADD1",124,0) ; Output: '1' authorized to write med orders, else '0' "RTN","RADD1",125,0) ;---------------------------------------------------------------------- "RTN","RADD1",126,0) Q $$VALADM^RADD4() "RTN","RADD1",127,0) ; "RTN","RADD1",128,0) VOL(RAX) ; Validate the format of the value input for volume. "RTN","RADD1",129,0) ; RAX must be a number followed by a space then text -or- "RTN","RADD1",130,0) ; a number followed by text "RTN","RADD1",131,0) ; Input Variable : 'RAX'- user's input "RTN","RADD1",132,0) ; Output Variable: null if 'RAX' erroneous, formatted version of 'RAX' "RTN","RADD1",133,0) Q $$VOL^RADD4() "RTN","RADD3") 0^1^B25368385^B22339745 "RTN","RADD3",1,0) RADD3 ;HISC/SWM-Radiology Data Dictionary Utility Routine ;9/11/97 16:23 "RTN","RADD3",2,0) ;;5.0;Radiology/Nuclear Medicine;**18,65**;Mar 16, 1998;Build 8 "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,X,Y "RTN","RADD3",135,0) S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," "RTN","RADD3",136,0) S RAFDA(70.07,RAIENS,.01)="NOW" "RTN","RADD3",137,0) D UPDATE^DIE("E","RAFDA","RAIEN") ;RAIEN(1)=ien of new record "RTN","RADD3",138,0) K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added "RTN","RADD3",139,0) S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," "RTN","RADD3",140,0) S RAFDA(70.07,RAIENS,2)="U" "RTN","RADD3",141,0) S RAFDA(70.07,RAIENS,3)=$G(RAWHO) "RTN","RADD3",142,0) S:$G(RATC)]"" RAFDA(70.07,RAIENS,4)=RATC "RTN","RADD3",143,0) D FILE^DIE(,"RAFDA") "RTN","RADD3",144,0) Q "RTN","RADD3",145,0) ; "RTN","RADD3",146,0) ;updates EXAM STATUS "RTN","RADD3",147,0) U70033(RA18DFN,RA18DTI,RA18CNI,RA18ST) ; "RTN","RADD3",148,0) N %,D,D0,DA,DIC,DIE,DQ,DR,RA18FDA,RA18IENS,X,Y "RTN","RADD3",149,0) S RA18IENS=RA18CNI_","_RA18DTI_","_RA18DFN_"," "RTN","RADD3",150,0) S RA18FDA(70.03,RA18IENS,3)=RA18ST "RTN","RADD3",151,0) D FILE^DIE(,"RA18FDA") "RTN","RADD3",152,0) Q "RTN","RADD3",153,0) ; "RTN","RADD4") 0^2^B2279618^B4471215 "RTN","RADD4",1,0) RADD4 ;HISC/GJC-Radiology Utility Routine ;11/25/97 12:40 "RTN","RADD4",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RADD4",3,0) ; "RTN","RADD4",4,0) ;supported IA #10104 reference to STRIP^XLFSTR and LOW^XLFSTR "RTN","RADD4",5,0) ; "RTN","RADD4",6,0) VALADM() ;edit validation "RTN","RADD4",7,0) ;Used to validate/screen radiopharm dosage administrator, "RTN","RADD4",8,0) ; radiopharm prescribing phys, person who measured radiopharm dose, "RTN","RADD4",9,0) ;---------------------------------------------------------------------- "RTN","RADD4",10,0) ; RAD0 : IEN of entry in question for NUC MED EXAM DATA (70.2) file "RTN","RADD4",11,0) ; Y : Pointer to the New Person file "RTN","RADD4",12,0) ; RADT : Xam Date; if not passed, calculate exam date from file 70.2 "RTN","RADD4",13,0) ; RAUTH : 1 - only staff/resid, must be auth'zd to write med orders "RTN","RADD4",14,0) ; : 0 - staff/resid & tech's "RTN","RADD4",15,0) ;---------------------------------------------------------------------- "RTN","RADD4",16,0) ; Output: '1' authorized to write med orders, else '0' "RTN","RADD4",17,0) ;---------------------------------------------------------------------- "RTN","RADD4",18,0) N RAPS S RAPS=$G(^VA(200,Y,"PS")) "RTN","RADD4",19,0) ; $P(RAPS,"^") - authorized to write med orders '1': Yes "RTN","RADD4",20,0) ; $P(RAPS,"^",4) - person CAN'T write med orders after this date(if any) "RTN","RADD4",21,0) S:$G(RADT)="" RADT=$P($G(^RADPTN(RAD0,0)),"^",2) "RTN","RADD4",22,0) I 'RAUTH,($D(^VA(200,"ARC","R",Y))!$D(^VA(200,"ARC","S",Y))!$D(^VA(200,"ARC","T",Y))) Q 1 "RTN","RADD4",23,0) I RAUTH,($D(^VA(200,"ARC","R",Y))!$D(^VA(200,"ARC","S",Y))),(+$P(RAPS,"^")),($S('$P(RAPS,"^",4):1,$P(RAPS,"^",4)'0 "" "RTN","RADD4",33,0) S RAY=$S($F(RAY," ")>0:$E(RAY,$F(RAY," "),9999),1:RAY) "RTN","RADD4",34,0) S RAY=$S($F(RAY,".")>0:$E(RAY,$F(RAY,"."),9999),1:RAY) "RTN","RADD4",35,0) S RAY=$$STRIP^XLFSTR(RAY,"0") "RTN","RADD4",36,0) S RAY=$$LOW^XLFSTR($E(RAY,1)) "RTN","RADD4",37,0) I RAY'="c",(RAY'="m") Q "" "RTN","RADD4",38,0) Q RAX1_" "_RAY "RTN","RADOSTIK") 0^3^B23645905^B22290587 "RTN","RADOSTIK",1,0) RADOSTIK ;HISC/GJC-Routine to print dosage tickets ;8/1/97 14:07 "RTN","RADOSTIK",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RADOSTIK",3,0) ; "RTN","RADOSTIK",4,0) ;Supported IA #2056 reference to GET1^DIQ "RTN","RADOSTIK",5,0) ;Supported IA #10103 reference to NOW^XLFDT and FMTE^XLFDT "RTN","RADOSTIK",6,0) ;Supported IA #10104 reference to CJ^XLFSTR and REPEAT^XLFSTR "RTN","RADOSTIK",7,0) ;Supported IA #2053 reference to FILE^DIE "RTN","RADOSTIK",8,0) ; "RTN","RADOSTIK",9,0) EN1(RADFN,RADTI,RACNI) ; the usual suspects "RTN","RADOSTIK",10,0) N I,RA1,RADTIK,RARDIO,RAY2,RAY3 "RTN","RADOSTIK",11,0) S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RA1=0 "RTN","RADOSTIK",12,0) S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RARDIO=+$P(RAY3,"^",28) "RTN","RADOSTIK",13,0) S RADTIK=+$P($G(^RA(79.1,+$P(RAY2,"^",4),0)),"^",23) "RTN","RADOSTIK",14,0) Q:'RADTIK ; no dosage ticket printer defined for this imaging location "RTN","RADOSTIK",15,0) Q:'RARDIO ; no Rpharms associated with this exam "RTN","RADOSTIK",16,0) Q:+$P(RAY3,"^",29) ; quit if dosage ticket has already been printed "RTN","RADOSTIK",17,0) N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE "RTN","RADOSTIK",18,0) S ZTDESC="Rad/Nuc Med Print dosage ticket or tickets for an Exam" "RTN","RADOSTIK",19,0) S ZTDTH=$H,ZTIO=$$GET1^DIQ(3.5,RADTIK_",",.01),ZTRTN="PRINT^RADOSTIK" "RTN","RADOSTIK",20,0) F I="RADFN","RARDIO","RAY2","RAY3" S ZTSAVE(I)="" "RTN","RADOSTIK",21,0) D ^%ZTLOAD D SETFLG^RADOSTIK(RADFN,RADTI,RACNI) "RTN","RADOSTIK",22,0) Q "RTN","RADOSTIK",23,0) EN2 ; Print duplicate dosage ticket "RTN","RADOSTIK",24,0) D:'$D(RACCESS(DUZ)) SET^RAPSET1 D ^RACNLU Q:X["^" "RTN","RADOSTIK",25,0) N I,RADOSTIK,RARDIO,RAY2,RAY3 "RTN","RADOSTIK",26,0) S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RADOSTIK="" "RTN","RADOSTIK",27,0) S RAY3=Y(0),RARDIO=+$P(RAY3,"^",28) ; RAY3 is the zero node of the exam "RTN","RADOSTIK",28,0) ; RADFN,RADTI & RACNI are all defined! "RTN","RADOSTIK",29,0) I 'RARDIO D D KILL Q "RTN","RADOSTIK",30,0) . W !!?3,"Dosage ticket data does not exist!",$C(7) "RTN","RADOSTIK",31,0) . Q "RTN","RADOSTIK",32,0) N ZTDESC,ZTRTN,ZTSAVE S ZTRTN="PRINT^RADOSTIK" "RTN","RADOSTIK",33,0) F I="RADFN","RADOSTIK","RARDIO","RAY2","RAY3" S ZTSAVE(I)="" "RTN","RADOSTIK",34,0) S ZTDESC="Rad/Nuc Med Print Duplicate Dosage Ticket option." "RTN","RADOSTIK",35,0) D ZIS^RAUTL I RAPOP D KILL Q "RTN","RADOSTIK",36,0) D PRINT,KILL "RTN","RADOSTIK",37,0) Q "RTN","RADOSTIK",38,0) PRINT ; Print out dosage ticket(s). If more than one rpharm, print one "RTN","RADOSTIK",39,0) ; dosage ticket per page. "RTN","RADOSTIK",40,0) U IO S:$D(ZTQUEUED) ZTREQ="@" "RTN","RADOSTIK",41,0) W:$D(RADOSTIK)&($E(IOST,1,2)="C-") @IOF "RTN","RADOSTIK",42,0) N RA1,RA702,RA719,RACNST,RANOTE,RAPRTDT,RATTLE,RAX,RAXIT "RTN","RADOSTIK",43,0) S (RA1,RAXIT)=0 "RTN","RADOSTIK",44,0) S RATTLE="Radiopharmaceutical Dose Computation and Measurement Record" "RTN","RADOSTIK",45,0) S RAPRTDT=$$NOW^XLFDT() "RTN","RADOSTIK",46,0) S:$L($P(RAPRTDT,".",2))>4 RAPRTDT=$P(RAPRTDT,".")_"."_$E($P(RAPRTDT,".",2),1,4) ; don't display seconds in printed date "RTN","RADOSTIK",47,0) S RAPRTDT="Printed: "_$$FMTE^XLFDT(RAPRTDT,"1P"),RACNST=$L(RAPRTDT) "RTN","RADOSTIK",48,0) F S RA1=$O(^RADPTN(RARDIO,"NUC",RA1)) Q:RA1'>0 D Q:RAXIT "RTN","RADOSTIK",49,0) . K RANOTE W !,$$CJ^XLFSTR(RATTLE,IOM),!,$$CJ^XLFSTR(RAPRTDT,IOM) "RTN","RADOSTIK",50,0) . I $D(ZTQUEUED),($D(RADOSTIK)) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 "RTN","RADOSTIK",51,0) . Q:RAXIT "RTN","RADOSTIK",52,0) . W !!,"Case : ",$P(RAY3,"^")_"@"_$$FMTE^XLFDT($P(RAY2,"^"),"1P") "RTN","RADOSTIK",53,0) . W !!,"Patient : ",$$GET1^DIQ(2,RADFN_",",.01) "RTN","RADOSTIK",54,0) . W !,"Patient ID : ",$$SSN^RAUTL() "RTN","RADOSTIK",55,0) . W !,"Study : ",$E($$GET1^DIQ(71,+$P(RAY3,"^",2)_",",.01),1,50) "RTN","RADOSTIK",56,0) . S RA702=$G(^RADPTN(RARDIO,"NUC",RA1,0)) "RTN","RADOSTIK",57,0) . W !!,"Radiopharmaceutical : " "RTN","RADOSTIK",58,0) . S RAX=$$EN1^RAPSAPI(+$P(RA702,"^"),.01) S:RAX="" RANOTE="" "RTN","RADOSTIK",59,0) . W $S(RAX]"":RAX,1:"*****") K RAX "RTN","RADOSTIK",60,0) . W !,"Form : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",15) "RTN","RADOSTIK",61,0) . D GETS^DIQ(71.9,+$P(RA702,"^",13)_",","*","","RA719") "RTN","RADOSTIK",62,0) . W !,"Lot No. : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",.01)) "RTN","RADOSTIK",63,0) . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX "RTN","RADOSTIK",64,0) . W !,"Kit No. : ",$G(RA719(71.9,+$P(RA702,"^",13)_",",4)) "RTN","RADOSTIK",65,0) . W !,"Lot Expiration Date : " S RAX=$G(RA719(71.9,+$P(RA702,"^",13)_",",3)) "RTN","RADOSTIK",66,0) . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX "RTN","RADOSTIK",67,0) . W !!,"Date/Time of Measurement: " S RAX=$$GET1^DIQ(70.21,RA1_","_RARDIO_",",5) "RTN","RADOSTIK",68,0) . S:RAX="" RANOTE="" W $S(RAX]"":RAX,1:"*****") K RAX "RTN","RADOSTIK",69,0) . W !,"Dose Prescribed : " "RTN","RADOSTIK",70,0) . I $P(RA702,"^",2)]"" W $P(RA702,"^",2)_" mCi" "RTN","RADOSTIK",71,0) . I $P(RA702,"^",2)']"",(+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0))) D "RTN","RADOSTIK",72,0) .. N RA7108 S RA7108=+$O(^RAMIS(71,+$P(RAY3,"^",2),"NUC","B",$P(RA702,"^"),0)) "RTN","RADOSTIK",73,0) .. S RA7108(0)=$G(^RAMIS(71,+$P(RAY3,"^",2),"NUC",RA7108,0)) "RTN","RADOSTIK",74,0) .. W:$P(RA7108(0),"^",6)]"" "Low: "_$P(RA7108(0),"^",6)_" mCi " "RTN","RADOSTIK",75,0) .. W:$P(RA7108(0),"^",5)]"" "High: "_$P(RA7108(0),"^",5)_" mCi" "RTN","RADOSTIK",76,0) .. Q "RTN","RADOSTIK",77,0) . W !,"Activity Drawn : ",$S($P(RA702,"^",4)]"":$P(RA702,"^",4)_" mCi",1:"*****") "RTN","RADOSTIK",78,0) . S:$P(RA702,"^",4)="" RANOTE="" "RTN","RADOSTIK",79,0) . W !,"Dose Administered : ",$S($P(RA702,"^",7)]"":$P(RA702,"^",7)_" mCi",1:"") "RTN","RADOSTIK",80,0) . W !,"Time of Administration : ",$$GET1^DIQ(70.21,RA1_","_RARDIO_",",8) "RTN","RADOSTIK",81,0) . W !!,"Signature of Person Measuring Dose: " "RTN","RADOSTIK",82,0) . W $$REPEAT^XLFSTR("_",((IOM-3)-$X)) K RA719 "RTN","RADOSTIK",83,0) . W:$D(RANOTE) !!,"NOTE: '*****' indicates that required pieces of information are missing." "RTN","RADOSTIK",84,0) . S:'$D(ZTQUEUED)&($D(RADOSTIK))&(+$O(^RADPTN(RARDIO,"NUC",RA1))) RAXIT=$$EOS^RAUTL5() Q:RAXIT "RTN","RADOSTIK",85,0) . W:+$O(^RADPTN(RARDIO,"NUC",RA1)) @IOF ; dosage ticket per page "RTN","RADOSTIK",86,0) . Q "RTN","RADOSTIK",87,0) D CLOSE^RAUTL,KILL^RADOSTIK "RTN","RADOSTIK",88,0) Q "RTN","RADOSTIK",89,0) KILL ; Kill variables "RTN","RADOSTIK",90,0) K %,%W,%Y,%Y1,C,RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RANME,RAPOP,RAPRC "RTN","RADOSTIK",91,0) K RARPT,RASSN,RAST,X,Y "RTN","RADOSTIK",92,0) K DIC,DIPGM,DISYS,DUOUT,I,RAHEAD,RAI,RAMES,RAEND,RAFL,RAFST,RAHEAD,RAIX "RTN","RADOSTIK",93,0) K ^TMP($J,"RAEX") "RTN","RADOSTIK",94,0) Q "RTN","RADOSTIK",95,0) SETFLG(RADFN,RADTI,RACNI) ; Set the 'Dosage Ticket Printed?' "RTN","RADOSTIK",96,0) ; ^DD(70.03,29,0) field to 'Yes'. "RTN","RADOSTIK",97,0) ; Input: RADFN==> Patient ien RADTI==> Inverse Date/Time of Exam "RTN","RADOSTIK",98,0) ; RACNI==> ien of the examination "RTN","RADOSTIK",99,0) N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",29)=1 "RTN","RADOSTIK",100,0) D FILE^DIE("","RAFDA") "RTN","RADOSTIK",101,0) Q "RTN","RAMAIN2") 0^6^B53609974^B51382730 "RTN","RAMAIN2",1,0) RAMAIN2 ;HISC/GJC-Radiology Utility File Maintenance (Part Two) ;8/15/05 10:07am "RTN","RAMAIN2",2,0) ;;5.0;Radiology/Nuclear Medicine;**45,62,71,65**;Mar 16, 1998;Build 8 "RTN","RAMAIN2",3,0) ; 08/12/2005 bay/kam Remedy Call 104630 Patch 62 "RTN","RAMAIN2",4,0) ; 03/02/2006 BAY/KAM Remedy Call 131482 Patch RA*5*71 "RTN","RAMAIN2",5,0) ; "RTN","RAMAIN2",6,0) ;Supported IA #10141 reference to MES^XPDUTL "RTN","RAMAIN2",7,0) ;Supported IA #10142 reference to EN^DDIOL "RTN","RAMAIN2",8,0) ;Supported IA #10103 reference to DT^XLFDT "RTN","RAMAIN2",9,0) ; "RTN","RAMAIN2",10,0) 2 ;;Procedure Enter/Edit "RTN","RAMAIN2",11,0) ; *** This subroutine once resided in RAMAIN i.e, '2^RAMAIN'. *** "RTN","RAMAIN2",12,0) ; RA PROCEDURE option "RTN","RAMAIN2",13,0) N RACTIVE,RAENALL,RAY,RAFILE,RASTAT,RAXIT "RTN","RAMAIN2",14,0) S (RAENALL,RANEW71,RAXIT)=0 "RTN","RAMAIN2",15,0) N RADIO,RAPTY,RAASK,RAROUTE ;used by the edit template "RTN","RAMAIN2",16,0) F D Q:$G(RAXIT) "RTN","RAMAIN2",17,0) . K DA,DD,DIC,DINUM,DLAYGO,DO,RACMDIFF,RATRKCMA,RATRKCMB "RTN","RAMAIN2",18,0) . S DIC="^RAMIS(71,",DIC(0)="QEAMLZ",DLAYGO=71,DIC("DR")=6 "RTN","RAMAIN2",19,0) . W ! D ^DIC K D,DD,DIC,DINUM,DLAYGO,DO "RTN","RAMAIN2",20,0) . S:+Y<0 RAXIT=1 I $G(RAXIT) K D,X,Y Q "RTN","RAMAIN2",21,0) . S (DA,RADA)=+Y,RAY=Y,RAFILE=71 "RTN","RAMAIN2",22,0) . ;RA*5*71 changed next line for Remedy Call 131482 "RTN","RAMAIN2",23,0) . S RANEW71=$S($P(Y,U,3)=1:1,1:0) ;used in template, edit CPT Code if new rec. "RTN","RAMAIN2",24,0) . L +^RAMIS(RAFILE,RADA):5 "RTN","RAMAIN2",25,0) . I '$T D Q "RTN","RAMAIN2",26,0) .. W !?5,"This record is currently being edited by another user." "RTN","RAMAIN2",27,0) .. W !?5,"Try again later!",$C(7) S RAXIT=1 "RTN","RAMAIN2",28,0) .. Q "RTN","RAMAIN2",29,0) . S RAPNM=$P($G(Y(0)),U) ;proc. name for display purposes in template "RTN","RAMAIN2",30,0) . S RACTIVE=$P($G(^RAMIS(71,RADA,"I")),"^") "RTN","RAMAIN2",31,0) . S RASTAT=$S(RACTIVE="":1,RACTIVE>DT:1,1:0) "RTN","RAMAIN2",32,0) . D TRKCMB^RAMAINU(DA,.RATRKCMB) ;tracks existing "RTN","RAMAIN2",33,0) . ; CM definition before editing. RATRKCMB ids the before CM values "RTN","RAMAIN2",34,0) . S DIE="^RAMIS(71,",DR="[RA PROCEDURE EDIT]" D ^DIE "RTN","RAMAIN2",35,0) . K RAPNM S RAPROC(0)=$G(^RAMIS(71,RADA,0)) "RTN","RAMAIN2",36,0) . ; "RTN","RAMAIN2",37,0) . ;check for data consistency between the 'CONTRAST MEDIA USED' & "RTN","RAMAIN2",38,0) . ;'CONTRAST MEDIA' fields. "RTN","RAMAIN2",39,0) . D CMINTEG^RAMAINU1(RADA,RAPROC(0)) "RTN","RAMAIN2",40,0) . ; "RTN","RAMAIN2",41,0) . D TRKCMA^RAMAINU(RADA,RATRKCMB,.RATRKCMA,.RACMDIFF) "RTN","RAMAIN2",42,0) . I $O(^RAMIS(71,RADA,"NUC",0)),($P(RAPROC(0),"^",2)=1) D DELRADE(RADA) "RTN","RAMAIN2",43,0) . S RACTIVE=$P($G(^RAMIS(71,RADA,"I")),"^") "RTN","RAMAIN2",44,0) . S RASTAT=RASTAT_"^"_$S(RACTIVE="":1,RACTIVE>DT:1,1:0) "RTN","RAMAIN2",45,0) . ; 08/12/2005 104630 KAM - added '$G(RANEW71) to next line "RTN","RAMAIN2",46,0) . I RAPROC(0)]"",("^B^P^"'[(U_$P(RAPROC(0),"^",6)_U)),('+$P(RAPROC(0),"^",9)),'+$G(RANEW71) D "RTN","RAMAIN2",47,0) .. K %,C,D0,DE,DI,DIE,DQ,DR "RTN","RAMAIN2",48,0) .. W !?5,$C(7),"...no CPT code entered..." "RTN","RAMAIN2",49,0) .. W !?5,"...will change type to a 'broad' procedure.",! "RTN","RAMAIN2",50,0) .. S DA=RADA,DIE="^RAMIS(71,",DR="6///B" D ^DIE "RTN","RAMAIN2",51,0) .. Q "RTN","RAMAIN2",52,0) . ;08/12/2005 104630 - KAM added next 5 lines "RTN","RAMAIN2",53,0) . I RAPROC(0)]"",("^B^P^"'[(U_$P(RAPROC(0),"^",6)_U)),('+$P(RAPROC(0),"^",9)),+$G(RANEW71) D "RTN","RAMAIN2",54,0) .. K %,C,D0,DE,DI,DIK,DQ,DR "RTN","RAMAIN2",55,0) .. W !?5,$C(7),"...no CPT code entered..." "RTN","RAMAIN2",56,0) .. W !?5,"...will delete the record at this time.",! "RTN","RAMAIN2",57,0) .. S DIK="^RAMIS(71,",DA=RADA D ^DIK K DIK "RTN","RAMAIN2",58,0) . ;if an active parent w/o descendants, inactivate the parent "RTN","RAMAIN2",59,0) . I $P(RASTAT,U,2),($P(RAPROC(0),U,6)="P"),('$O(^RAMIS(71,RADA,4,0))) D "RTN","RAMAIN2",60,0) .. K D,D0,D1,DA,DI,DIC,DIE,DQ,DR "RTN","RAMAIN2",61,0) .. W !!?5,"Inactivating this parent procedure - no descendents.",!,$C(7) "RTN","RAMAIN2",62,0) .. S DA=RADA,DIE="^RAMIS(71,",DR="100///"_$S($D(DT):DT,1:$$DT^XLFDT()) "RTN","RAMAIN2",63,0) .. D ^DIE K D,D0,D1,DA,DI,DIC,DIE,DQ,DR S $P(RASTAT,U,2)=0 ;inactive "RTN","RAMAIN2",64,0) .. Q "RTN","RAMAIN2",65,0) . I $P($G(^RA(79.2,+$P(RAPROC(0),U,12),0)),U,5)="Y",(+$O(^RAMIS(71,RADA,"NUC",0))) D VRDIO(RADA) "RTN","RAMAIN2",66,0) . I "^B^P^"[(U_$P(RAPROC(0),U,6)_U),($P(RAPROC(0),U,9)]"") D "RTN","RAMAIN2",67,0) .. K %,D,D0,DA,DE,DIC,DIE,DQ,DR "RTN","RAMAIN2",68,0) .. S DA=RADA,DIE="^RAMIS(71,",DR="9///@" D ^DIE "RTN","RAMAIN2",69,0) .. W !!?5,"...CPT code deleted because "_$S($P(RAPROC(0),U,6)="B":"Broad",1:"Parent")_" procedures",!?5,"should not have CPT codes.",!,$C(7) "RTN","RAMAIN2",70,0) .. Q "RTN","RAMAIN2",71,0) . K %,%X,%Y,C,D,D0,D1,DA,DE,DI,DIE,DQ,DR,RAIMAG,RAMIS,RAPROC,X,Y "RTN","RAMAIN2",72,0) .;send Orderable Item HL7 msg to CPRS if the ORDER DIALOG (#101.41) "RTN","RAMAIN2",73,0) .;file exists unconditionally "RTN","RAMAIN2",74,0) .D:$$ORQUIK^RAORDU()=1 PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) "RTN","RAMAIN2",75,0) .; "RTN","RAMAIN2",76,0) . L -^RAMIS(RAFILE,RADA) K RADA "RTN","RAMAIN2",77,0) .;unconditionally update the parent procedure if the descendent "RTN","RAMAIN2",78,0) .I $O(^RAMIS(71,"ADESC",+RAY,0)) D UPDATP^RAO7UTL(RAY) "RTN","RAMAIN2",79,0) .;has been edited "RTN","RAMAIN2",80,0) . Q "RTN","RAMAIN2",81,0) K DIR,RACMDIFF,RATRKCMA,RATRKCMB "RTN","RAMAIN2",82,0) S DIR(0)="YA",DIR("B")="NO" "RTN","RAMAIN2",83,0) S DIR("A")="Want to run a validity check on CPT and stop codes? " "RTN","RAMAIN2",84,0) S DIR("?",1)="Answer 'YES' to print a list of Radiology/Nuclear Medicine Procedures" "RTN","RAMAIN2",85,0) S DIR("?",2)="with missing or invalid CPT's and/or Credit Clinic Stop Code(s)." "RTN","RAMAIN2",86,0) S DIR("?",3)="Broad procedures with invalid codes are included for information" "RTN","RAMAIN2",87,0) S DIR("?",4)="only. Inactive procedures are not required to have valid codes." "RTN","RAMAIN2",88,0) S DIR("?",5)="To be valid, Stop Codes must be in the Imaging Stop Codes file 71.5;" "RTN","RAMAIN2",89,0) S DIR("?",6)="CPT's must be nationally active." "RTN","RAMAIN2",90,0) S DIR("?")="Please answer 'YES' or 'NO'." "RTN","RAMAIN2",91,0) W ! D ^DIR K DIR G:$D(DIRUT) EXIT "RTN","RAMAIN2",92,0) D:Y ^RAPERR "RTN","RAMAIN2",93,0) EXIT K RADA,RANEW71,X,Y "RTN","RAMAIN2",94,0) Q "RTN","RAMAIN2",95,0) 13 ;;Rad/Nuc Med Common Procedure File Enter/Edit "RTN","RAMAIN2",96,0) ; RA COMMON PROCEDURE option "RTN","RAMAIN2",97,0) N RADA,RAENALL,RAY,RAFILE,RALOW,RAMIS713,RASTAT,RAIMGTYI S RAENALL=0 "RTN","RAMAIN2",98,0) W ! D EN1^RAUTL17 G:Y'>0 Q13 S RAIMGTYI=Y "RTN","RAMAIN2",99,0) 131 S DIC="^RAMIS(71.3,",DIC(0)="AELMQZ",DLAYGO=71.3 "RTN","RAMAIN2",100,0) S DIC("S")="N RA S RA=+$P(^(0),U) I RAIMGTYI=$P($G(^RAMIS(71,RA,0)),U,12)" "RTN","RAMAIN2",101,0) S DIC("W")="N RA4 S RA4=$P($G(^(0)),""^"",4) W:RA4]"""" "" (""_RA4_"")"" W:RA4']"""" "" (no sequence number)""" "RTN","RAMAIN2",102,0) W ! D ^DIC K DIC,DLAYGO,D,X "RTN","RAMAIN2",103,0) I Y<0 D Q13 G RESEQ "RTN","RAMAIN2",104,0) ; If a sequence # exists, the Common Proc. is active "RTN","RAMAIN2",105,0) S RADA=+Y,RAY=Y,RAFILE=71.3 L +^RAMIS(RAFILE,RADA):5 "RTN","RAMAIN2",106,0) I '$T D G Q13 "RTN","RAMAIN2",107,0) . W !?5,"This record is currently being edited by another user." "RTN","RAMAIN2",108,0) . W !?5,"Try again later!",$C(7) "RTN","RAMAIN2",109,0) . Q "RTN","RAMAIN2",110,0) S RASTAT=$S($P(Y(0),"^",4)]"":1,1:0)_"^" "RTN","RAMAIN2",111,0) I '+$P(RASTAT,"^") S RALOW=$$LOW(RAIMGTYI) "RTN","RAMAIN2",112,0) S DA=RADA,DIE="^RAMIS(71.3,",DR="[RA COMMON PROCEDURE EDIT]" D ^DIE "RTN","RAMAIN2",113,0) S RAMIS713(0)=$G(^RAMIS(71.3,RADA,0)) "RTN","RAMAIN2",114,0) ; If the procedure is different than the one originally selected and "RTN","RAMAIN2",115,0) ; the CPRS Order Dialog file exists, send the Orderable Item Update "RTN","RAMAIN2",116,0) ; message to CPRS. "RTN","RAMAIN2",117,0) I $P(RAMIS713(0),"^")'=$P(RAY,"^",2),($$ORQUIK^RAORDU()=1) D "RTN","RAMAIN2",118,0) . S RASTAT=RASTAT_0 D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) "RTN","RAMAIN2",119,0) . S RAY=RADA_"^"_$P($G(^RAMIS(71.3,RADA,0)),"^")_"^"_1,RASTAT=0_"^" "RTN","RAMAIN2",120,0) . Q "RTN","RAMAIN2",121,0) K %,%X,%Y,C,D,D0,DA,DE,DI,DIE,DQ,DR,X,Y "RTN","RAMAIN2",122,0) S RASTAT=RASTAT_$S($P($G(^RAMIS(71.3,+RAY,0)),"^",4)]"":1,1:0) "RTN","RAMAIN2",123,0) ; If before & after statuses differ, and the CPRS Order Dialog file "RTN","RAMAIN2",124,0) ; exists, send the Orderable Item Update message to CPRS. "RTN","RAMAIN2",125,0) I $$ORQUIK^RAORDU()=1,(($P(RASTAT,"^")+$P(RASTAT,"^",2))=1) D "RTN","RAMAIN2",126,0) . D PROC^RAO7MFN(RAENALL,RAFILE,RASTAT,RAY) "RTN","RAMAIN2",127,0) . Q "RTN","RAMAIN2",128,0) L -^RAMIS(RAFILE,RADA) "RTN","RAMAIN2",129,0) G 131 "RTN","RAMAIN2",130,0) Q13 K DDC,DDH,DISYS,I,POP,RA713 "RTN","RAMAIN2",131,0) Q "RTN","RAMAIN2",132,0) RESEQ ;Resequence the common procedure list "RTN","RAMAIN2",133,0) N D,D0,DI,DQ,H,I,J,CNT,DIC,DIE,DR,DA,TXT,X "RTN","RAMAIN2",134,0) I $D(XPDNM) D ; if called during package install "RTN","RAMAIN2",135,0) . S TXT(1)=" " "RTN","RAMAIN2",136,0) . S TXT(2)="Resequencing the Rad/Nuc Med Common Procedure List." "RTN","RAMAIN2",137,0) . Q "RTN","RAMAIN2",138,0) E W !!?5,"Resequencing the Rad/Nuc Med Common Procedure List" "RTN","RAMAIN2",139,0) S DIE="^RAMIS(71.3,",(I,CNT)=0 "RTN","RAMAIN2",140,0) F S I=$O(^RAMIS(71.3,"AA",RAIMGTYI,I)) Q:I'>0 D "RTN","RAMAIN2",141,0) . S J=0 "RTN","RAMAIN2",142,0) . F S J=$O(^RAMIS(71.3,"AA",RAIMGTYI,I,J)) Q:J'>0 I $D(^RAMIS(71.3,J,0)) D "RTN","RAMAIN2",143,0) .. S DA=J,CNT=CNT+1 N I,J "RTN","RAMAIN2",144,0) .. S DR="3////^S X=CNT" D ^DIE W:'$D(XPDNM) "." "RTN","RAMAIN2",145,0) .. Q "RTN","RAMAIN2",146,0) . Q "RTN","RAMAIN2",147,0) I $D(XPDNM) D ; if called during package install "RTN","RAMAIN2",148,0) . S TXT(2)=$G(TXT(2))_" Done!" "RTN","RAMAIN2",149,0) . D MES^XPDUTL(.TXT) "RTN","RAMAIN2",150,0) . Q "RTN","RAMAIN2",151,0) E W " Done!" "RTN","RAMAIN2",152,0) Q "RTN","RAMAIN2",153,0) LOW(X) ; Find the lowest available sequence number for a procedure within "RTN","RAMAIN2",154,0) ; a specific Imaging Type. Seq. #'s range from 1 to 40. If the "RTN","RAMAIN2",155,0) ; range changes in the DD i.e, ^DD(71.3,3, this code as well as the "RTN","RAMAIN2",156,0) ; code if EN3^RAUTL18 must also be altered. "RTN","RAMAIN2",157,0) ; If RAHIT is passed back as "", there is no available sequence number. "RTN","RAMAIN2",158,0) N RA,RAHIT S RAHIT="" "RTN","RAMAIN2",159,0) F RA=1:1:40 D Q:RAHIT "RTN","RAMAIN2",160,0) . Q:$D(^RAMIS(71.3,"AA",X,RA)) "RTN","RAMAIN2",161,0) . S:RAHIT="" RAHIT=RA "RTN","RAMAIN2",162,0) . Q "RTN","RAMAIN2",163,0) Q RAHIT "RTN","RAMAIN2",164,0) VRDIO(RADA) ; Validate the 'Usual Dose' field within the 'Default Radiopha- "RTN","RAMAIN2",165,0) ; rmaceuticals' multiple. 'Usual Dose' must fall within the 'Low Adult "RTN","RAMAIN2",166,0) ; Dose' & 'High Adult Dose' range. This subroutine will display the "RTN","RAMAIN2",167,0) ; Radiopharmaceutical in question along with the values in question if "RTN","RAMAIN2",168,0) ; inconsistencies are found. "RTN","RAMAIN2",169,0) ; "RTN","RAMAIN2",170,0) ; Input Variable: 'RADA' the ien of the Procedure "RTN","RAMAIN2",171,0) N RANUC S RADA(1)=RADA,RADA=0 D EN^DDIOL("","","!") "RTN","RAMAIN2",172,0) F S RADA=$O(^RAMIS(71,RADA(1),"NUC",RADA)) Q:RADA'>0 D "RTN","RAMAIN2",173,0) . S RANUC(0)=$G(^RAMIS(71,RADA(1),"NUC",RADA,0)) "RTN","RAMAIN2",174,0) . Q:$P(RANUC(0),"^",2)="" ; no need to validate, nothing input "RTN","RAMAIN2",175,0) . I '$$USUAL^RADD2(.RADA,$P(RANUC(0),"^",2)) D "RTN","RAMAIN2",176,0) .. N RARRY S RARRY(1)="For Radiopharmaceutical: " "RTN","RAMAIN2",177,0) .. S RARRY(1)=RARRY(1)_$$EN1^RAPSAPI(+$P(RANUC(0),"^"),.01)_$C(7) "RTN","RAMAIN2",178,0) .. S RARRY(2)="" D EN^DDIOL(.RARRY,"") "RTN","RAMAIN2",179,0) .. Q "RTN","RAMAIN2",180,0) . Q "RTN","RAMAIN2",181,0) Q "RTN","RAMAIN2",182,0) DELRADE(RADA) ; Delete the Default Radiopharmaceuticals multiple "RTN","RAMAIN2",183,0) N RADA1 S RADA1=0 "RTN","RAMAIN2",184,0) W !!?3,"Deleting default radiopharmaceuticals for this procedure...",! "RTN","RAMAIN2",185,0) F S RADA1=$O(^RAMIS(71,RADA,"NUC",RADA1)) Q:RADA1'>0 D "RTN","RAMAIN2",186,0) . K %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y "RTN","RAMAIN2",187,0) . S DA(1)=RADA,DA=RADA1,DIE="^RAMIS(71,"_RADA_",""NUC""," "RTN","RAMAIN2",188,0) . S DR=".01///@" D ^DIE "RTN","RAMAIN2",189,0) . Q "RTN","RAMAIN2",190,0) K %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y "RTN","RAMAIN2",191,0) Q "RTN","RAMAIN2",192,0) ; "RTN","RANMED1") 0^9^B11414707^B9123243 "RTN","RANMED1",1,0) RANMED1 ;HISC/SWM-Nuclear Medicine Enter/Edit Routine ;1/21/97 11:07 "RTN","RANMED1",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RANMED1",3,0) ; "RTN","RANMED1",4,0) ;Supported IA #10142 reference to EN^DDIOL "RTN","RANMED1",5,0) ;DBIA: 4551 DIC^PSSDI looks up & screens records from file #50 "RTN","RANMED1",6,0) ROUTE ; Enter/Edit file 71.6 "RTN","RANMED1",7,0) W ! N RA1,RA2 S RA1=0 "RTN","RANMED1",8,0) S DIC="^RAMIS(71.6,",DIC(0)="AEQLMZ" D ^DIC "RTN","RANMED1",9,0) G:+Y<1 EXIT S DA=+Y,DIE=DIC,DR=".01;100" D ^DIE "RTN","RANMED1",10,0) W !!?5,"Current parameters for entry of sites for this route :" "RTN","RANMED1",11,0) W !!?5,"PROMPT FOR FREE TEXT SITE? = ",$P(^RAMIS(71.6,DA,0),U,3) "RTN","RANMED1",12,0) W !?5,"VALID SITES OF ADMINISTRATION = " F S RA1=$O(^RAMIS(71.6,DA,"SITE",RA1)) Q:'RA1 I +^(RA1,0) S RA2=$P(^RAMIS(71.7,+^(0),0),U) W:($L(RA2)+2+$X)>80 !?10 W RA2 W:$O(^RAMIS(71.6,DA,"SITE",RA1)) ";" W " " "RTN","RANMED1",13,0) W !!?21,"-- NOTE -- ",!?10,"If 'PROMPT FOR FREE TEXT SITE?' is 'Y',",!?10,"then users will not be given a selection",!?10,"of predefined 'VALID SITES'" "RTN","RANMED1",14,0) S DIR(0)="SO^P:PROMPT FOR FREE TEXT SITE?;V:VALID SITES OF ADMINISTRATION" "RTN","RANMED1",15,0) S DIR("A")="Edit which field" "RTN","RANMED1",16,0) D ^DIR "RTN","RANMED1",17,0) G:$G(DIRUT) ROUTE "RTN","RANMED1",18,0) S DR=$S(X="V":2,X="P":3,1:"") G:'DR ROUTE "RTN","RANMED1",19,0) D ^DIE "RTN","RANMED1",20,0) G ROUTE "RTN","RANMED1",21,0) SITE ; Enter/Edit file 71.7 "RTN","RANMED1",22,0) W ! "RTN","RANMED1",23,0) S DIC="^RAMIS(71.7,",DIC(0)="AEQLMZ" D ^DIC "RTN","RANMED1",24,0) G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE "RTN","RANMED1",25,0) G SITE "RTN","RANMED1",26,0) SOURCE ; Enter/Edit file 71.8 "RTN","RANMED1",27,0) W ! "RTN","RANMED1",28,0) S DIC="^RAMIS(71.8,",DIC(0)="AEQLMZ" D ^DIC "RTN","RANMED1",29,0) G:+Y<1 EXIT S DA=+Y S DIE=DIC,DR=".01:999" D ^DIE "RTN","RANMED1",30,0) G SOURCE "RTN","RANMED1",31,0) LOT ; Enter/Edit file 71.9 "RTN","RANMED1",32,0) ;RA*5*65 SG "RTN","RANMED1",33,0) N DA,DIC,DIDEL,DIE,DINUM,DLAYGO,DR,DTOUT,DUOUT,EXIT,TMP,X,Y "RTN","RANMED1",34,0) S EXIT=0 "RTN","RANMED1",35,0) F D Q:EXIT "RTN","RANMED1",36,0) . ;--- Select a record "RTN","RANMED1",37,0) . S DIC="^RAMIS(71.9,",DIC(0)="AEQLMSZ" "RTN","RANMED1",38,0) . W ! D ^DIC "RTN","RANMED1",39,0) . I Y'>0 S EXIT=1 Q "RTN","RANMED1",40,0) . ;--- Edit the record "RTN","RANMED1",41,0) . S DA=+Y,DIE=DIC "RTN","RANMED1",42,0) . S DR=".01:4;5///^S X=$$RXEDIT^RAPSAPI3(""R"","""_DA_","",71.9,5,DT);6" "RTN","RANMED1",43,0) . D ^DIE "RTN","RANMED1",44,0) Q "RTN","RANMED1",45,0) WARN ; Warn if dose is out-of-range, called from [RA EXAM EDIT] "RTN","RANMED1",46,0) Q:'$D(RADTI)!('$D(RADFN)) "RTN","RANMED1",47,0) N RA1,RAXDIV,RADOT S RA1=0 ; RAXDIV=exam's division "RTN","RANMED1",48,0) S $P(RADOT,"o ",40)="" "RTN","RANMED1",49,0) S RAXDIV=+$P(^RADPT(RADFN,"DT",RADTI,0),U,3) "RTN","RANMED1",50,0) I '$O(^RA(79,RAXDIV,"RWARN",0)) W !!,RADOT,!?14,"This dose level requires a written, dated and signed",!?27,"directive by a physician.",!,RADOT,! Q "RTN","RANMED1",51,0) W !,RADOT "RTN","RANMED1",52,0) F S RA1=$O(^RA(79,RAXDIV,"RWARN",RA1)) Q:'RA1 W !?((80-$L(^(RA1,0)))/2),^(0) "RTN","RANMED1",53,0) W !,RADOT,! "RTN","RANMED1",54,0) Q "RTN","RANMED1",55,0) EXIT K DIC,DIE,DIR,DA,DR,DIRUT "RTN","RANMED1",56,0) K C,D,D0,DDH,DG,DI,DISYS,DQ,DST,DUOUT,I,POP "RTN","RANMED1",57,0) K RA719IEN,RAFDA,DIE,DA,DR,RAVACL,RAYN,RAENTRY,RA50IEN,RANODEL,RASTUFF "RTN","RANMED1",58,0) K RAHLP3,RAFIN "RTN","RANMED1",59,0) Q "RTN","RANMED1",60,0) DUPL ;check for duplicate entry into file 71.9 "RTN","RANMED1",61,0) Q:'$O(^RAMIS(71.9,"B",X,0)) "RTN","RANMED1",62,0) Q:'$D(RAOPT("NM EDIT LOT")) ;prevent msg appearing in other options "RTN","RANMED1",63,0) N RA "RTN","RANMED1",64,0) S RA(1)="**WARNING** An entry already exists for LOT NUMBER/ID = "_X "RTN","RANMED1",65,0) S RA(1,"F")="!!?7,*7" "RTN","RANMED1",66,0) S RA(2)="If you want to add another LOT NUMBER/ID with the same value" "RTN","RANMED1",67,0) S RA(2,"F")="!!?7" "RTN","RANMED1",68,0) S RA(3)="then put "" "" around the value, eg. """_X_"""" "RTN","RANMED1",69,0) S RA(3,"F")="!?7" "RTN","RANMED1",70,0) S RA(4)="" "RTN","RANMED1",71,0) S RA(4,"F")="!!" "RTN","RANMED1",72,0) D EN^DDIOL(.RA) "RTN","RANMED1",73,0) Q "RTN","RANMUSE2") 0^4^B37954161^B36990000 "RTN","RANMUSE2",1,0) RANMUSE2 ;HISC/SWM-Nuclear Medicine Usage reports ;9/3/97 14:37 "RTN","RANMUSE2",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RANMUSE2",3,0) ; "RTN","RANMUSE2",4,0) ;Supported IA #10061 reference to DEM^VADPT "RTN","RANMUSE2",5,0) ; "RTN","RANMUSE2",6,0) SET ; There are 2 parts: set local arrays and ^tmp() "RTN","RANMUSE2",7,0) ; "RTN","RANMUSE2",8,0) ; part 1 -- raseqd(),raseqi(),ranumd(),ranumi() so to reduce "RTN","RANMUSE2",9,0) ; div and img-typ names to a single number, and so to reduce "RTN","RANMUSE2",10,0) ; the length of the ^tmp() string "RTN","RANMUSE2",11,0) ; raseqd("division name")=sequence number for alpha sort order "RTN","RANMUSE2",12,0) ; raseqi("imaging type name")=sequence number for alpha sort order "RTN","RANMUSE2",13,0) ; ranumd(sequence number for alpha sort order)="division name" "RTN","RANMUSE2",14,0) ; ranumi(sequence number for alpha sort order)="imaging type name" "RTN","RANMUSE2",15,0) ; "RTN","RANMUSE2",16,0) S RA1=0 F S RA1=$O(^RA(79,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2 RASEQD($P($G(^DIC(4,+RA2,0)),U))="" "RTN","RANMUSE2",17,0) S RA1="",RA2=1 F S RA1=$O(RASEQD(RA1)) Q:RA1="" S RASEQD(RA1)=RA2,RANUMD(RA2)=RA1,RA2=RA2+1 "RTN","RANMUSE2",18,0) ; "RTN","RANMUSE2",19,0) S RA1=0 F S RA1=$O(^RA(79.2,RA1)) Q:'RA1 S RA2=$P($G(^(RA1,0)),U) S:RA2]"" RASEQI(RA2)="" "RTN","RANMUSE2",20,0) S RA1="",RA2=1 F S RA1=$O(RASEQI(RA1)) Q:RA1="" S RASEQI(RA1)=RA2,RANUMI(RA2)=RA1,RA2=RA2+1 "RTN","RANMUSE2",21,0) ; "RTN","RANMUSE2",22,0) ; part 2 -- ^TMP($J,"RA",div,imgtyp,S3,S4,patnam,caseno) "RTN","RANMUSE2",23,0) ; S3 = sort field 3, either radiopharm/whoadmin or examdttm "RTN","RANMUSE2",24,0) ; S4 = sort field 4, either examdttm or radiopharm/whoadmin "RTN","RANMUSE2",25,0) ; "RTN","RANMUSE2",26,0) ; Loop thru ^RADPTN("AB" to select recs within requested date range "RTN","RANMUSE2",27,0) ; "RTN","RANMUSE2",28,0) S RA0=RADTBEG-.0001 "RTN","RANMUSE2",29,0) S1 S RA0=$O(^RADPTN("AB",RA0)) Q:RA0="" Q:RA0>RADTEND S RA1=0 "RTN","RANMUSE2",30,0) S2 S RA1=$O(^RADPTN("AB",RA0,RA1)) G:RA1="" S1 "RTN","RANMUSE2",31,0) S RAN0=$G(^RADPTN(RA1,0)) G:RAN0="" S2 "RTN","RANMUSE2",32,0) S RADFN=$P(RAN0,U) G:RADFN="" S2 "RTN","RANMUSE2",33,0) S RADTI=9999999.9999-$P(RAN0,U,2) G:RADTI="" S2 "RTN","RANMUSE2",34,0) S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",$P(RAN0,U,3),0)) G:RACNI="" S2 "RTN","RANMUSE2",35,0) D EXTRACT "RTN","RANMUSE2",36,0) G S2 "RTN","RANMUSE2",37,0) EXTRACT ; "RTN","RANMUSE2",38,0) S P02=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:P02="" "RTN","RANMUSE2",39,0) S P03=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:P03="" "RTN","RANMUSE2",40,0) S RADIVNAM=$P($G(^DIC(4,+$P(P02,U,3),0)),U) "RTN","RANMUSE2",41,0) Q:'$D(^TMP($J,"RA D-TYPE",RADIVNAM)) ; div not selected "RTN","RANMUSE2",42,0) S RAIMGNAM=$P($G(^RA(79.2,+$P(P02,U,2),0)),U) "RTN","RANMUSE2",43,0) Q:'$D(^TMP($J,"RA I-TYPE",RAIMGNAM)) ; img typ not selected "RTN","RANMUSE2",44,0) S RA2=0 "RTN","RANMUSE2",45,0) F1 S RA2=$O(^RADPTN(RA1,"NUC",RA2)) Q:RA2'=+RA2 "RTN","RANMUSE2",46,0) S RANUC=^RADPTN(RA1,"NUC",RA2,0) "RTN","RANMUSE2",47,0) S RACN=$P(RAN0,U,3) "RTN","RANMUSE2",48,0) S RADIOPH=$$EN1^RAPSAPI(+$P(RANUC,U),.01) ; Radiopharm Name "RTN","RANMUSE2",49,0) I 'RAINPUT,RATITLE["Usage",'$D(^TMP($J,"RA EITHER",RADIOPH)) G F1 ;radioph not selectd "RTN","RANMUSE2",50,0) S RAWHO=$P($G(^VA(200,+$P(RANUC,U,9),0)),U) ; who administered dose "RTN","RANMUSE2",51,0) I RATITLE["Admin",RAWHO="" G F1 ;who admin dose is unknown "RTN","RANMUSE2",52,0) I 'RAINPUT,RATITLE["Admin",'$D(^TMP($J,"RA EITHER",RAWHO)) G F1 ;who not selectd "RTN","RANMUSE2",53,0) S RAXMDTM=$P(RAN0,U,2) ; exam date/time "RTN","RANMUSE2",54,0) S RAPRC0=$G(^RAMIS(71,+$P(P03,U,2),0)) ; procedure 0-node "RTN","RANMUSE2",55,0) S RAPRCNAM=$P(RAPRC0,U) ; procedure name "RTN","RANMUSE2",56,0) S DFN=RADFN D DEM^VADPT "RTN","RANMUSE2",57,0) S RAPATNAM=$P(VADM(1),U) ; patient name "RTN","RANMUSE2",58,0) S RASSN=$P(VADM(2),U,2) ; ssn "RTN","RANMUSE2",59,0) K VADM "RTN","RANMUSE2",60,0) S RADOSE=$P(RANUC,U,7) ; dose administered "RTN","RANMUSE2",61,0) S RADRAWN=$P(RANUC,U,4) ; activity drawn "RTN","RANMUSE2",62,0) I 'RADOSE,'RADRAWN G F1 ; dose admin and drawn both null/zero "RTN","RANMUSE2",63,0) ; ien of procedure sub-record with matching radiopharm "RTN","RANMUSE2",64,0) ; if user changes default radiopharm entry, or "RTN","RANMUSE2",65,0) ; adds a radiopharm that's not defined in file 71 default radiopharm, "RTN","RANMUSE2",66,0) ; the high and low values would be unknown "RTN","RANMUSE2",67,0) S RANUC1=$O(^RAMIS(71,+$P(P03,U,2),"NUC","B",+$P(RANUC,U),0)) "RTN","RANMUSE2",68,0) ; 0-node of procedure sub-record with matching radiopharm "RTN","RANMUSE2",69,0) S:RANUC1 RANUC1=^RAMIS(71,+$P(P03,U,2),"NUC",+RANUC1,0) "RTN","RANMUSE2",70,0) S RAHIGH=$P(RANUC1,U,5) ; high adult dose "RTN","RANMUSE2",71,0) S RALOW=$P(RANUC1,U,6) ; low adult dose "RTN","RANMUSE2",72,0) S RASTERSK="" "RTN","RANMUSE2",73,0) I RADOSE>0,RALOW>0,RADOSE0,RAHIGH>0,RADOSE>RAHIGH S RASTERSK="*" "RTN","RANMUSE2",75,0) D S3S4 "RTN","RANMUSE2",76,0) S ^TMP($J,"RA",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),S3,S4,$E(RAPATNAM,1,15),RACN,RADIOPH)=RASSN_U_RADRAWN_U_RADOSE_U_RAHIGH_U_RALOW_U_RAWHO_U_RASTERSK_U_RAPRCNAM "RTN","RANMUSE2",77,0) I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN)) S ^(RASEQI(RAIMGNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM)))+1,^(RASEQD(RADIVNAM))=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM)))+1 "RTN","RANMUSE2",78,0) S RAEITHER=$S(RATITLE["Usage":RADIOPH,1:RAWHO) "RTN","RANMUSE2",79,0) I '$D(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER)) S ^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1,^(RAEITHER)=$G(^TMP($J,"RATUNIQ",RASEQD(RADIVNAM),RAEITHER))+1 "RTN","RANMUSE2",80,0) S ^(RASSN)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN))+1 "RTN","RANMUSE2",81,0) S ^(RAEITHER)=$G(^TMP($J,"RASUM",$S(RASORT:S3,1:S4),RACN,RASSN,RAEITHER))+1 "RTN","RANMUSE2",82,0) ; img typ totals "RTN","RANMUSE2",83,0) S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 "RTN","RANMUSE2",84,0) S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADRAWN "RTN","RANMUSE2",85,0) S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+RADOSE "RTN","RANMUSE2",86,0) ; "ratradio" is used for either radiopharm or who-admin-dose "RTN","RANMUSE2",87,0) S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RASEQI(RAIMGNAM),RAEITHER))+1 "RTN","RANMUSE2",88,0) ; division totals "RTN","RANMUSE2",89,0) S:RASTERSK="*" ^(RAEITHER)=$G(^TMP($J,"RATOUTSD",RASEQD(RADIVNAM),RAEITHER))+1 "RTN","RANMUSE2",90,0) S ^(RAEITHER)=$G(^TMP($J,"RATDRAWN",RASEQD(RADIVNAM),RAEITHER))+RADRAWN "RTN","RANMUSE2",91,0) S ^(RAEITHER)=$G(^TMP($J,"RATDOSE",RASEQD(RADIVNAM),RAEITHER))+RADOSE "RTN","RANMUSE2",92,0) S ^(RAEITHER)=$G(^TMP($J,"RATRADIO",RASEQD(RADIVNAM),RAEITHER))+1 "RTN","RANMUSE2",93,0) G F1 "RTN","RANMUSE2",94,0) WRT S RASEQD="" "RTN","RANMUSE2",95,0) W1 S RASEQD=$O(^TMP($J,"RA",RASEQD)) Q:RASEQD="" S RASEQI="" "RTN","RANMUSE2",96,0) W2 S RASEQI=$O(^TMP($J,"RA",RASEQD,RASEQI)) G:RASEQI="" W1 S S3="" "RTN","RANMUSE2",97,0) S:RAPG>0 RAXIT=$$EOS^RAUTL5 Q:$G(RAXIT) D PGHD^RANMUSE3,COLHD^RANMUSE3 "RTN","RANMUSE2",98,0) W3 S S3=$O(^TMP($J,"RA",RASEQD,RASEQI,S3)) G:S3="" W2 S S4="" "RTN","RANMUSE2",99,0) W4 S S4=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4)) G:S4="" W3 S RAPATNAM="" "RTN","RANMUSE2",100,0) W5 S RAPATNAM=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM)) G:RAPATNAM="" W4 S RACN="" "RTN","RANMUSE2",101,0) W6 S RACN=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN)) G:RACN="" W5 S RADIOPH="" "RTN","RANMUSE2",102,0) W7 S RADIOPH=$O(^TMP($J,"RA",RASEQD,RASEQI,S3,S4,RAPATNAM,RACN,RADIOPH)) G:RADIOPH="" W6 S RA1=^(RADIOPH) "RTN","RANMUSE2",103,0) S RALONGCN=$S(RASORT:S3,1:S4),RALONGCN=$E(RALONGCN,4,7)_$E(RALONGCN,2,3)_"-"_RACN_"@"_$E($P(RALONGCN,".",2)_"000",1,4) "RTN","RANMUSE2",104,0) S RASSN=$P(RA1,U),RADRAWN=$P(RA1,U,2),RADOSE=$P(RA1,U,3),RAHIGH=$P(RA1,U,4),RALOW=$P(RA1,U,5),RAWHO=$P(RA1,U,6),RASTERSK=$P(RA1,U,7) "RTN","RANMUSE2",105,0) S RAPRCNAM=$P(RA1,U,8) "RTN","RANMUSE2",106,0) I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD^RANMUSE3,COLHD^RANMUSE3 "RTN","RANMUSE2",107,0) W !,RALONGCN,?16,$E(RAPATNAM,1,15),?32,RASSN,?44,$E(RADIOPH,1,15),?59,$J(RADRAWN,10,4),?69,$J(RADOSE,10,4),?79,$J(RALOW,10,4),?89,$J(RAHIGH,10,4),?100,$E(RAPRCNAM,1,15),?116,$E(RAWHO,1,15),?131,RASTERSK "RTN","RANMUSE2",108,0) G W7 "RTN","RANMUSE2",109,0) S3S4 ; set subscripts 3 and 4 "RTN","RANMUSE2",110,0) I RATITLE["Usage" D Q "RTN","RANMUSE2",111,0) . I RASORT S S4=$E(RADIOPH,1,15),S3=RAXMDTM "RTN","RANMUSE2",112,0) . I 'RASORT S S3=$E(RADIOPH,1,15),S4=RAXMDTM "RTN","RANMUSE2",113,0) . Q "RTN","RANMUSE2",114,0) I RATITLE["Admin" D Q "RTN","RANMUSE2",115,0) . I RASORT S S4=$E(RAWHO,1,15),S3=RAXMDTM "RTN","RANMUSE2",116,0) . I 'RASORT S S3=$E(RAWHO,1,15),S4=RAXMDTM "RTN","RANMUSE2",117,0) . Q "RTN","RANMUSE2",118,0) Q "RTN","RANMUSE3") 0^11^B15377223^B14878113 "RTN","RANMUSE3",1,0) RANMUSE3 ;HISC/SWM-Nuclear Medicine Usage reports ;10/20/97 11:09 "RTN","RANMUSE3",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RANMUSE3",3,0) PGHD ; Page Header "RTN","RANMUSE3",4,0) I RAPG!($E(IOST,1,2)="C-") W:$Y>0 @IOF "RTN","RANMUSE3",5,0) S RAPG=RAPG+1 "RTN","RANMUSE3",6,0) W !?35,">>> "_RATITLE_" Report <<<",?90,"Run Date: ",RATDY "RTN","RANMUSE3",7,0) W ?121,"Page: ",RAPG "RTN","RANMUSE3",8,0) W !?50,$S($G(RAHDTYP)="D":"(Division",$G(RAHDTYP)="I":"(Imaging",1:"") W:$G(RAHDTYP)]"" " Summary)" "RTN","RANMUSE3",9,0) W ?85,"For: ",RADTBEG("X")," - ",RADTEND("X") "RTN","RANMUSE3",10,0) W !,"Division: ",RANUMD(RASEQD) W:$G(RAHDTYP)'="D" ?45,"Imaging Type: ",RANUMI(RASEQI) "RTN","RANMUSE3",11,0) Q "RTN","RANMUSE3",12,0) COLHD ; Column Header for detailed report "RTN","RANMUSE3",13,0) W !!,"Long-Case@Time",?16,"Patient Name",?35,"SSN",?44,"Radiopharm",?59,"Act.Drawn",?69,"Dose Adm'd",?83,"Low",?93,"High",?100,"Procedure",?116,"Who Adm'd" "RTN","RANMUSE3",14,0) W !,RALN "RTN","RANMUSE3",15,0) Q "RTN","RANMUSE3",16,0) COLHDS ; Column Header for summary report "RTN","RANMUSE3",17,0) W !!,$S(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose"),?35,"Total Drawn",?50,"Total Adm'd",?64,"No. cases",?79,"(%)",?90,"No. outside range" "RTN","RANMUSE3",18,0) W !,RALN "RTN","RANMUSE3",19,0) Q "RTN","RANMUSE3",20,0) SUM S RAXIT=$$EOS^RAUTL5 Q:RAXIT "RTN","RANMUSE3",21,0) S RA0=0 "RTN","RANMUSE3",22,0) SM0 S RA0=$O(^TMP($J,"RATUNIQ",RA0)) Q:'RA0 S RA1=0 "RTN","RANMUSE3",23,0) SM2 S RA1=$O(^TMP($J,"RATUNIQ",RA0,RA1)) I RA1'=+RA1 D DIVSUM Q:RAXIT G SM0 "RTN","RANMUSE3",24,0) ; if RA1 is alpha, then node is for division summary "RTN","RANMUSE3",25,0) ; if RA1 is numeric, then node is for imaging summary "RTN","RANMUSE3",26,0) S RASEQD=RA0,RASEQI=RA1 "RTN","RANMUSE3",27,0) S RAHDTYP="I" D PGHD,COLHDS "RTN","RANMUSE3",28,0) SM3 S RA2=$O(^TMP($J,"RATUNIQ",RA0,RA1,RA2)) I RA2="" D FOOTIMG S RAXIT=$$EOS^RAUTL5 Q:RAXIT G SM2 "RTN","RANMUSE3",29,0) W !,$E(RA2,1,30) "RTN","RANMUSE3",30,0) W ?30,$J($G(^TMP($J,"RATDRAWN",RA0,RA1,RA2)),15,4) "RTN","RANMUSE3",31,0) W ?45,$J($G(^TMP($J,"RATDOSE",RA0,RA1,RA2)),15,4) "RTN","RANMUSE3",32,0) W ?64,$J($G(^TMP($J,"RATUNIQ",RA0,RA1,RA2)),7) "RTN","RANMUSE3",33,0) W ?78,$J(100*$S(+$G(^TMP($J,"RATUNIQ",RA0,RA1))=0:0,1:$G(^TMP($J,"RATUNIQ",RA0,RA1,RA2))/^TMP($J,"RATUNIQ",RA0,RA1)),5,2) "RTN","RANMUSE3",34,0) W ?90,$J($G(^TMP($J,"RATOUTSD",RA0,RA1,RA2)),7) "RTN","RANMUSE3",35,0) I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD,COLHDS "RTN","RANMUSE3",36,0) G SM3 "RTN","RANMUSE3",37,0) DIVSUM ; "RTN","RANMUSE3",38,0) ; skip div summary page if div has only 1 img typ "RTN","RANMUSE3",39,0) Q:$O(^TMP($J,"RATUNIQ",RA0,0))=$O(^TMP($J,"RATUNIQ",RA0,"A"),-1) "RTN","RANMUSE3",40,0) S RAHDTYP="D",RA2="A" "RTN","RANMUSE3",41,0) D PGHD,COLHDS "RTN","RANMUSE3",42,0) DV1 S RA2=$O(^TMP($J,"RATUNIQ",RA0,RA2)) "RTN","RANMUSE3",43,0) I RA2="" D FOOTDIV S RAXIT=$$EOS^RAUTL5 Q "RTN","RANMUSE3",44,0) W !,$E(RA2,1,30) "RTN","RANMUSE3",45,0) W ?30,$J($G(^TMP($J,"RATDRAWN",RA0,RA2)),15,4) "RTN","RANMUSE3",46,0) W ?45,$J($G(^TMP($J,"RATDOSE",RA0,RA2)),15,4) "RTN","RANMUSE3",47,0) W ?64,$J($G(^TMP($J,"RATUNIQ",RA0,RA2)),7) "RTN","RANMUSE3",48,0) W ?78,$J(100*$S(+$G(^TMP($J,"RATUNIQ",RA0))=0:0,1:$G(^TMP($J,"RATUNIQ",RA0,RA2))/^TMP($J,"RATUNIQ",RA0)),5,2) "RTN","RANMUSE3",49,0) W ?90,$J($G(^TMP($J,"RATOUTSD",RA0,RA2)),7) "RTN","RANMUSE3",50,0) I ($Y+4)>IOSL!(RAPG=0) S RAXIT=$$EOS^RAUTL5 Q:RAXIT D PGHD,COLHDS "RTN","RANMUSE3",51,0) G DV1 "RTN","RANMUSE3",52,0) FOOTDIV ; footnotes division "RTN","RANMUSE3",53,0) W !!,RANUMD(RASEQD),"'s Total number of unique cases: ",^TMP($J,"RATUNIQ",RA0) "RTN","RANMUSE3",54,0) D FOOT Q "RTN","RANMUSE3",55,0) FOOTIMG ; footnotes img type "RTN","RANMUSE3",56,0) W !!,RANUMI(RASEQI),"'s Total number of unique cases: ",^TMP($J,"RATUNIQ",RA0,RA1) "RTN","RANMUSE3",57,0) D FOOT Q "RTN","RANMUSE3",58,0) FOOT W !!,"Notes: A case may have more than 1 radiopharm, so total no. unique cases may be less than total no. radiopharms listed." "RTN","RANMUSE3",59,0) W !," * denotes administered dosage outside of normal range." "RTN","RANMUSE3",60,0) Q:RAINPUT "RTN","RANMUSE3",61,0) W !!,$S(RATITLE["Usage":"Radiopharm",1:"Dose administerers")," selected for this report :" W !?6 "RTN","RANMUSE3",62,0) S RA2=0 F S RA2=$O(^TMP($J,"RA EITHER",RA2)) Q:RA2="" W:$X+$L(RA2)>(IOM+2) !?6 W RA2 W:$O(^(RA2))]"" ", " "RTN","RANMUSE3",63,0) Q "RTN","RANMUSE3",64,0) ZERO ; zero out total for imaging type(s) and associated division(s) w/o data "RTN","RANMUSE3",65,0) S RA0="" "RTN","RANMUSE3",66,0) Z1 S RA0=$O(^TMP($J,"RA D-TYPE",RA0)) Q:RA0']"" S RA1="" "RTN","RANMUSE3",67,0) Z2 S RA1=$O(RACCESS(DUZ,"DIV-IMG",RA0,RA1)) G:RA1']"" Z1 "RTN","RANMUSE3",68,0) G:'$D(^TMP($J,"RA I-TYPE",RA1)) Z2 "RTN","RANMUSE3",69,0) S:'$D(^TMP($J,"RATUNIQ",RASEQD(RA0),RASEQI(RA1))) ^TMP($J,"RATUNIQ",RASEQD(RA0),RASEQI(RA1))=0 "RTN","RANMUSE3",70,0) S:'($D(^TMP($J,"RATUNIQ",RASEQD(RA0)))#2) ^TMP($J,"RATUNIQ",RASEQD(RA0))=0 "RTN","RANMUSE3",71,0) G Z2 "RTN","RANMUTL1") 0^5^B14346054^B14352459 "RTN","RANMUTL1",1,0) RANMUTL1 ;HISC/SWM-Nuclear Medicine utilites ;8/6/97 08:48 "RTN","RANMUTL1",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RANMUTL1",3,0) ; "RTN","RANMUTL1",4,0) ;Supported IA #10103 reference to FMTE^XLFDT "RTN","RANMUTL1",5,0) ; "RTN","RANMUTL1",6,0) SELIMG ; Select Imaging Type, if exists; code is from RAUTL7 "RTN","RANMUTL1",7,0) ; Prompts user to select Imaging Type(s). "RTN","RANMUTL1",8,0) ; Creates ^TMP($J,"RA I-TYPE",Imaging Type name,Imaging Type IEN)="" "RTN","RANMUTL1",9,0) N RA,RAIMGNUM,RAONE S RA="",RAONE=$$IMG1^RAUTL7() "RTN","RANMUTL1",10,0) ; .... chk if only 1 img type is available "RTN","RANMUTL1",11,0) I $P(RAONE,"^")]"",('$D(^TMP($J,"RA D-TYPE"))) S RAQUIT=0 D Q "RTN","RANMUTL1",12,0) . S ^TMP($J,"RA I-TYPE",$P(RAONE,"^"),$P(RAONE,"^",2))="" "RTN","RANMUTL1",13,0) . Q "RTN","RANMUTL1",14,0) ; .... chk if only 1 img type within selectable division is available "RTN","RANMUTL1",15,0) ; raimgnum = number of selectable img types "RTN","RANMUTL1",16,0) I $D(^TMP($J,"RA D-TYPE")) D "RTN","RANMUTL1",17,0) . D SETUP1 S RAIMGNUM=$$IMGNUM^RAUTL7A() "RTN","RANMUTL1",18,0) . Q "RTN","RANMUTL1",19,0) I $D(^TMP($J,"RA D-TYPE")),(RAIMGNUM=1) D S RAQUIT=0 Q "RTN","RANMUTL1",20,0) . N RA0,RA1 "RTN","RANMUTL1",21,0) . S RA1=+$O(^TMP($J,"DIV-IMG",0)),RA0=$P($G(^RA(79.2,RA1,0)),"^") "RTN","RANMUTL1",22,0) . S ^TMP($J,"RA I-TYPE",RA0,RA1)="" "RTN","RANMUTL1",23,0) . Q "RTN","RANMUTL1",24,0) S RADIC="^RA(79.2,",RADIC(0)="QEAMZ",RAUTIL="RA I-TYPE" "RTN","RANMUTL1",25,0) S RADIC("A")="Select Imaging Type: ",RADIC("B")="All" "RTN","RANMUTL1",26,0) I $D(^TMP($J,"RA D-TYPE")) D "RTN","RANMUTL1",27,0) . S RADIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))" "RTN","RANMUTL1",28,0) . Q "RTN","RANMUTL1",29,0) ; why do we need to check the alternative ? DIVLOC+3 prevents this "RTN","RANMUTL1",30,0) ; alternative from occurring. "RTN","RANMUTL1",31,0) E S RADIC("S")="I $D(RACCESS(DUZ,""IMG"",+Y))" "RTN","RANMUTL1",32,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RANMUTL1",33,0) Q "RTN","RANMUTL1",34,0) SELRADIO ; Setup ^TMP($J,"RA EITHER",ien file 50) "RTN","RANMUTL1",35,0) S RAINPUT="" "RTN","RANMUTL1",36,0) K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes" "RTN","RANMUTL1",37,0) S DIR("A")="Do you wish to include all Radiopharms ? " "RTN","RANMUTL1",38,0) S DIR("?",1)="Enter 'Yes' to select all Radiopharms." "RTN","RANMUTL1",39,0) S DIR("?")="Enter 'No' to select a subset of Radiopharms." "RTN","RANMUTL1",40,0) W ! D ^DIR K DIR Q:$D(DIRUT) "RTN","RANMUTL1",41,0) S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RANMUTL1",42,0) Q:RAINPUT "RTN","RANMUTL1",43,0) S RADIC="^PSDRUG(",RADIC(0)="QEAMZ" "RTN","RANMUTL1",44,0) S RADIC("A")="Select Radiopharm: " "RTN","RANMUTL1",45,0) W !! D EN2^RAPSAPI(.RADIC,"RA EITHER") K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RANMUTL1",46,0) Q "RTN","RANMUTL1",47,0) SELADMIN ; Setup ^TMP($J,"RA EITHER",ien file 50) "RTN","RANMUTL1",48,0) S RAINPUT="" "RTN","RANMUTL1",49,0) K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes" "RTN","RANMUTL1",50,0) S DIR("A")="Do you wish to include all who administered dose ? " "RTN","RANMUTL1",51,0) S DIR("?",1)="Enter 'Yes' to select all who administered dose." "RTN","RANMUTL1",52,0) S DIR("?")="Enter 'No' to select some who administered dose." "RTN","RANMUTL1",53,0) W ! D ^DIR K DIR Q:$D(DIRUT) "RTN","RANMUTL1",54,0) S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RANMUTL1",55,0) Q:RAINPUT "RTN","RANMUTL1",56,0) S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA EITHER" "RTN","RANMUTL1",57,0) S RADIC("A")="Select Person Who Admin Dose: " "RTN","RANMUTL1",58,0) ; passed parameters to circumvent person's inactive date "RTN","RANMUTL1",59,0) ; only the 4th param, 0, is really used to choose staff/resid/tech "RTN","RANMUTL1",60,0) S RADIC("S")="I $$VALADM^RADD1(1,+Y,1,0)" ; "RTN","RANMUTL1",61,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RANMUTL1",62,0) Q "RTN","RANMUTL1",63,0) SELDATES ; Define RADTBEG and RADTEND "RTN","RANMUTL1",64,0) S RAPOP=0 W !!,"**** Date Range Selection ****" "RTN","RANMUTL1",65,0) W ! S %DT="APEXT" "RTN","RANMUTL1",66,0) S %DT("A")=" Beginning DATE : " "RTN","RANMUTL1",67,0) S %DT("B")="T-1" "RTN","RANMUTL1",68,0) D ^%DT S:Y<0 RAPOP=1 Q:Y<0 S (%DT(0),RADTBEG)=Y "RTN","RANMUTL1",69,0) W ! S %DT="APEXT" "RTN","RANMUTL1",70,0) S %DT("A")=" Ending DATE : " "RTN","RANMUTL1",71,0) S %DT("B")="T-1@24:00" "RTN","RANMUTL1",72,0) D ^%DT K %DT S:Y<0 RAPOP=1 Q:Y<0 S RADTEND=Y "RTN","RANMUTL1",73,0) S RADTBEG("X")=$$FMTE^XLFDT(RADTBEG,1) ; for display in header "RTN","RANMUTL1",74,0) S RADTEND("X")=$$FMTE^XLFDT(RADTEND,1) "RTN","RANMUTL1",75,0) S:$P(RADTEND,".",2)="" RADTEND=RADTEND_".9999" "RTN","RANMUTL1",76,0) Q "RTN","RANMUTL1",77,0) SELSORT ; select sort order "RTN","RANMUTL1",78,0) W ! S RAPOP=0,RASORT=0 "RTN","RANMUTL1",79,0) S DIR("A")="Sort Exam Date/Time before "_$S(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose")_" ? : " "RTN","RANMUTL1",80,0) S DIR(0)="YAO",DIR("B")="NO" D ^DIR "RTN","RANMUTL1",81,0) I $D(DIRUT)!($D(DUOUT)) S RAPOP=1 Q "RTN","RANMUTL1",82,0) S RASORT=Y ; 1=YES, 0=NO "RTN","RANMUTL1",83,0) Q "RTN","RANMUTL1",84,0) SETUP1 ; Setup ^TMP($J,"DIV-IMG",Imaging Type IEN)="" "RTN","RANMUTL1",85,0) ; based upon ^TMP($J,"RA D-TYPE",Division name) "RTN","RANMUTL1",86,0) ; RACCESS "DIV-IMG" "RTN","RANMUTL1",87,0) ; elements. "RTN","RANMUTL1",88,0) N RAX,RAY,RAZ S RAX="" "RTN","RANMUTL1",89,0) F S RAX=$O(^TMP($J,"RA D-TYPE",RAX)) Q:RAX']"" D "RTN","RANMUTL1",90,0) . I $D(RACCESS(DUZ,"DIV-IMG",RAX)) D "RTN","RANMUTL1",91,0) .. S RAY="" F S RAY=$O(RACCESS(DUZ,"DIV-IMG",RAX,RAY)) Q:RAY']"" D "RTN","RANMUTL1",92,0) ... Q:$P($G(^RA(79.2,+$O(^RA(79.2,"B",RAY,0)),0)),U,5)'="Y" ;file 79.2's RADIOPHARM..USED "RTN","RANMUTL1",93,0) ... S RAZ=+$O(^RA(79.2,"B",RAY,0)),^TMP($J,"DIV-IMG",RAZ)="" "RTN","RANMUTL1",94,0) ... Q "RTN","RANMUTL1",95,0) .. Q "RTN","RANMUTL1",96,0) . Q "RTN","RANMUTL1",97,0) Q "RTN","RAPSAPI") 0^8^B19025307^n/a "RTN","RAPSAPI",1,0) RAPSAPI ;HOIFO/SWM-calling Pharmacy APIs ;8/29/05 08:12 "RTN","RAPSAPI",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RAPSAPI",3,0) ; "RTN","RAPSAPI",4,0) ;DBIA: 4533 DATA^PSS50 returns external value of field from file #50 "RTN","RAPSAPI",5,0) ;DBIA: 4533 ZERO^PSS50 returns B crossreference of file #50 "RTN","RAPSAPI",6,0) ;DBIA: 4551 DO^PSSDI puts header info from file #50 into local vars "RTN","RAPSAPI",7,0) ;DBIA: 4551 ($$FNAME^PSSDI) returns field value from file #50 "RTN","RAPSAPI",8,0) ;DBIA: 4551 DIC^PSSDI looks up & screens records from file #50 "RTN","RAPSAPI",9,0) ;DBIA: 2055 reference to ROOT^DILFD "RTN","RAPSAPI",10,0) Q "RTN","RAPSAPI",11,0) EN1(RAX,RAN) ; call data^pss50 to get external values to some fields "RTN","RAPSAPI",12,0) ; input RAX is ien to file 50 "RTN","RAPSAPI",13,0) ; input RAN is field number of file 50 to display "RTN","RAPSAPI",14,0) N RAY,X,SCR "RTN","RAPSAPI",15,0) S:RAX="" RAX=+RAX "RTN","RAPSAPI",16,0) K ^TMP($J,"RAPSS50") "RTN","RAPSAPI",17,0) D DATA^PSS50(RAX,"","","","","RAPSS50") "RTN","RAPSAPI",18,0) S RAY=$G(^TMP($J,"RAPSS50",RAX,RAN)) "RTN","RAPSAPI",19,0) K ^TMP($J,"RAPSS50") "RTN","RAPSAPI",20,0) Q RAY "RTN","RAPSAPI",21,0) EN2(RADIC,RAUTIL) ; adapted from EN1^RASELCT "RTN","RAPSAPI",22,0) ; called from selradio+11^RANMUTL1 "RTN","RAPSAPI",23,0) ;REQUIRES: "RTN","RAPSAPI",24,0) ; RADIC = FILE NUMBER OR GLOBAL ROOT "RTN","RAPSAPI",25,0) ; RADIC(0) = DIC(0) STRING "RTN","RAPSAPI",26,0) ; RAUTIL = NODE TO STORE DATA UNDER IN ^TMP($J,RAUTIL, "RTN","RAPSAPI",27,0) ; RAVACL() = ARRAY OF VA CLASS DRUGS TO INCLUDE "RTN","RAPSAPI",28,0) ; RAVACL("R") = INDICATE RADIOPHARMS ONLY "RTN","RAPSAPI",29,0) ;OPTIONAL: "RTN","RAPSAPI",30,0) ; RADIC("A") = DIC("A") STRING "RTN","RAPSAPI",31,0) ; RADIC("S") is not accepted by DIC^PSSDI "RTN","RAPSAPI",32,0) ; "RTN","RAPSAPI",33,0) ;RETURNS: "RTN","RAPSAPI",34,0) ; 1) RAQUIT = $S(UP_ARROW_OUT:1 , NOTHING_SELECTED:1 , 1:0) "RTN","RAPSAPI",35,0) ; 2) ^TMP($J,RAUTIL,EXTERNAL_.01_FIELD_DATA,IEN) = "" "RTN","RAPSAPI",36,0) ; "RTN","RAPSAPI",37,0) S RAQUIT=0 "RTN","RAPSAPI",38,0) I ($G(RADIC)="")!($G(RADIC(0))="")!($G(RAUTIL)="") S RAQUIT=1 G EXIT "RTN","RAPSAPI",39,0) N DIC,PSSDIY,X,Y "RTN","RAPSAPI",40,0) D K S DIC=RADIC I DIC S (RADIC,DIC)=$$ROOT^DILFD(DIC) I DIC="" S RAQUIT=1 G EXIT "RTN","RAPSAPI",41,0) S DIC(0)=RADIC(0),DIC(0)=$TR(DIC(0),"AL") S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z" S RADIC(0)=DIC(0) "RTN","RAPSAPI",42,0) D DO^PSSDI(50,"RA",.RADIC) "RTN","RAPSAPI",43,0) I PSSDIY=-1 S RAQUIT=1 G EXIT ; -1 if file access invalid "RTN","RAPSAPI",44,0) S RAFNAME=$P(DO,"^"),RAFLD01=$$FNAME^PSSDI(.01,50) K DO "RTN","RAPSAPI",45,0) S RANUM=1 K ^TMP($J,RAUTIL) D HOME^%ZIS "RTN","RAPSAPI",46,0) 1 ; "RTN","RAPSAPI",47,0) W !!,$S(RANUM>1:"Another one (Select/De-Select): ",1:RADIC("A")) "RTN","RAPSAPI",48,0) R X:DTIME S:('$T)!($E(X)="^") RAQUIT=1 G:RAQUIT EXIT G:X="" EXIT S RADSEL=$S(X?1"-"1.E:1,1:0) S:RADSEL X=$E(X,2,$L(X)) "RTN","RAPSAPI",49,0) I $L(X),(X["*") D SOME G 1 "RTN","RAPSAPI",50,0) ;removed checking for ALL because user answered "N" to all in selradio^ranmutl1 "RTN","RAPSAPI",51,0) D HELP:$E(X)="?" "RTN","RAPSAPI",52,0) ; cannot call old SEL() to prevent reselection since can't use DIC("S") "RTN","RAPSAPI",53,0) ; but no problem as same drug is stored only once in ^TMP "RTN","RAPSAPI",54,0) ; "RTN","RAPSAPI",55,0) ; null 6th piece skip check drug inactive dt -- want select old drugs "RTN","RAPSAPI",56,0) D SETVACL^RAPSAPI2("R") "RTN","RAPSAPI",57,0) D DIC^PSSDI(50,"RA",.RADIC,.X,"","","",.RAVACL) "RTN","RAPSAPI",58,0) G:+Y'>0 1 "RTN","RAPSAPI",59,0) ; no rafld "RTN","RAPSAPI",60,0) I 'RADSEL,'$D(^TMP($J,RAUTIL,$E($P(Y,U,2),1,63),+Y)) S ^(+Y)="",RANUM=RANUM+1 "RTN","RAPSAPI",61,0) I RADSEL,$D(^TMP($J,RAUTIL,$E($P(Y,U,2),1,63),+Y)) K ^(+Y) S RANUM=RANUM-$S(RANUM>0:1,1:0) "RTN","RAPSAPI",62,0) G 1 "RTN","RAPSAPI",63,0) EXIT ; "RTN","RAPSAPI",64,0) S RAQUIT=$S(RAQUIT:1,$O(^TMP($J,RAUTIL,""))="":1,1:0) K RADIC,RAUTIL "RTN","RAPSAPI",65,0) K K %,%X,%Y,%Z,C,D0,DA,DIC,DIK,DIR,DO,RA,RAALL,RACASE,RAD0,RADSEL,RAFLD01 "RTN","RAPSAPI",66,0) K RAFNAME,RAFNUM,RAFSCR,RALINE,RANUM,RAVALUE,X,Y,RAVACL "RTN","RAPSAPI",67,0) Q "RTN","RAPSAPI",68,0) SOME ; SG 4/12/07 "RTN","RAPSAPI",69,0) N RA50I,RADIC0,RAENTRY,RAXN,NAME "RTN","RAPSAPI",70,0) I $E(X,$L(X))'="*" W " ??",$C(7) Q "RTN","RAPSAPI",71,0) I $L(X)=1 W " ?? Enter at least 1 character before the ""*"".",$C(7) Q "RTN","RAPSAPI",72,0) S RADIC0=RADIC(0),RADIC(0)="" ; no terminal output "RTN","RAPSAPI",73,0) S RAENTRY=$E(X,1,$L(X)-1) "RTN","RAPSAPI",74,0) D ZERO^PSS50(,RAENTRY,,,,"RAPSS50") "RTN","RAPSAPI",75,0) S RAXN="" "RTN","RAPSAPI",76,0) F S RAXN=$O(^TMP($J,"RAPSS50","B",RAXN)) Q:RAXN="" D "RTN","RAPSAPI",77,0) . S RA50I=0 "RTN","RAPSAPI",78,0) . F S RA50I=$O(^TMP($J,"RAPSS50","B",RAXN,RA50I)) Q:RA50I'>0 D "RTN","RAPSAPI",79,0) . . ; screen data "RTN","RAPSAPI",80,0) . . D SETVACL^RAPSAPI2("R") "RTN","RAPSAPI",81,0) . . D DIC^PSSDI(50,"RA",.RADIC,"`"_RA50I,,,,.RAVACL) "RTN","RAPSAPI",82,0) . . Q:+Y'>0 "RTN","RAPSAPI",83,0) . . S NAME=$E($P(Y,U,2),1,63) "RTN","RAPSAPI",84,0) . . ; add "RTN","RAPSAPI",85,0) . . I 'RADSEL D:'$D(^TMP($J,RAUTIL,NAME,+Y)) Q "RTN","RAPSAPI",86,0) . . . S ^TMP($J,RAUTIL,NAME,+Y)="",RANUM=RANUM+1 "RTN","RAPSAPI",87,0) . . ; remove "RTN","RAPSAPI",88,0) . . I $D(^TMP($J,RAUTIL,NAME,+Y)) K ^(+Y) S:RANUM>0 RANUM=RANUM-1 "RTN","RAPSAPI",89,0) S RADIC(0)=RADIC0 "RTN","RAPSAPI",90,0) K ^TMP($J,"RAPSS50") "RTN","RAPSAPI",91,0) Q "RTN","RAPSAPI",92,0) HELP ; "RTN","RAPSAPI",93,0) N X S RA="Select a "_RAFNAME_" "_RAFLD01_" from the displayed list." D WRAP "RTN","RAPSAPI",94,0) W !?5,"To deselect a ",RAFLD01," type a minus sign (-)",!?5,"in front of it, e.g., -",RAFLD01,"." "RTN","RAPSAPI",95,0) W !?5,"Use an asterisk (*) to do a wildcard selection, e.g.," "RTN","RAPSAPI",96,0) W !?5,"enter ",RAFLD01,"* to select all entries that begin" "RTN","RAPSAPI",97,0) W !?5,"with the text '",RAFLD01,"'. Wildcard selection is" "RTN","RAPSAPI",98,0) W !?5,"case sensitive." "RTN","RAPSAPI",99,0) G:$O(^TMP($J,RAUTIL,""))="" HLP "RTN","RAPSAPI",100,0) SHOW S RALINE=$Y,RA="" W !!,"You have already selected:" "RTN","RAPSAPI",101,0) F S RA=$O(^TMP($J,RAUTIL,RA)) Q:RA=""!RAQUIT F RAD0=0:0 S RAD0=$O(^TMP($J,RAUTIL,RA,RAD0)) Q:RAD0'>0!RAQUIT D SHO "RTN","RAPSAPI",102,0) HLP W ! S RAQUIT=0 "RTN","RAPSAPI",103,0) Q "RTN","RAPSAPI",104,0) SHO W !?3,RA "RTN","RAPSAPI",105,0) I $Y>(IOSL+RALINE-3) D PAUSE S RALINE=$Y "RTN","RAPSAPI",106,0) Q "RTN","RAPSAPI",107,0) WRAP ; "RTN","RAPSAPI",108,0) W ! F S Y=$L($E(RA,1,IOM-20)," ") W !?5,$P(RA," ",1,Y) S RA=$P(RA," ",Y+1,999) Q:RA="" "RTN","RAPSAPI",109,0) Q "RTN","RAPSAPI",110,0) PAUSE ; "RTN","RAPSAPI",111,0) K DIR S DIR(0)="E" D ^DIR K DIR S RAQUIT=$S(Y:0,1:1) "RTN","RAPSAPI",112,0) Q "RTN","RAPSAPI",113,0) ; exclude SETDIC and SEL(Y) sections from routine RASELCT "RTN","RAPSAPI",114,0) ; "RTN","RAPSAPI",115,0) EN5() ;display identifier from file 71.9, field 5 radiopharm "RTN","RAPSAPI",116,0) ; ^(0) is ^RAMIS(71.9,-,0) "RTN","RAPSAPI",117,0) Q $$EN1(+$P(^(0),U,5),.01) "RTN","RAPSAPI2") 0^10^B40591298^n/a "RTN","RAPSAPI2",1,0) RAPSAPI2 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/6/07 3:43pm "RTN","RAPSAPI2",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RAPSAPI2",3,0) ; "RTN","RAPSAPI2",4,0) ;Supported IA #2053 reference to FILE^DIE "RTN","RAPSAPI2",5,0) ;Supported IA #2052 reference to FIELD^DID and GET1^DID "RTN","RAPSAPI2",6,0) ;Supported IA #2055 reference to ROOT^DILFD and OREF^DILFD "RTN","RAPSAPI2",7,0) ;Supported IA #10007 reference to DO^DIC1 "RTN","RAPSAPI2",8,0) ;Supported IA #4551 reference to DIC^PSSDI "RTN","RAPSAPI2",9,0) ;Supported IA #10029 reference to ^DIWW "RTN","RAPSAPI2",10,0) ; "RTN","RAPSAPI2",11,0) Q "RTN","RAPSAPI2",12,0) ; "RTN","RAPSAPI2",13,0) ;***** DISPLAYS RECORD DELETE PROMPT AND GETS USER RESPONSE "RTN","RAPSAPI2",14,0) ; "RTN","RAPSAPI2",15,0) ; RAIEN IEN of the record of the multiple "RTN","RAPSAPI2",16,0) ; "RTN","RAPSAPI2",17,0) ; IEN50 Internal value of the .01 field "RTN","RAPSAPI2",18,0) ; "RTN","RAPSAPI2",19,0) ; Return values: "RTN","RAPSAPI2",20,0) ; 0 Keep the record or there is nothing to delete "RTN","RAPSAPI2",21,0) ; 1 Delete the record "RTN","RAPSAPI2",22,0) ; "RTN","RAPSAPI2",23,0) ; Note: This is an internal function. Do not call it from outside "RTN","RAPSAPI2",24,0) ; of the RAPSAPI3 routine. "RTN","RAPSAPI2",25,0) ; "RTN","RAPSAPI2",26,0) DELCONF(RAIEN,IEN50) ; "RTN","RAPSAPI2",27,0) I (RAIEN'>0)!(IEN50'>0) W "??" Q 0 "RTN","RAPSAPI2",28,0) N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,TMP,X,Y "RTN","RAPSAPI2",29,0) S DIR(0)="YAO" "RTN","RAPSAPI2",30,0) S DIR("A")=" SURE YOU WANT TO DELETE",TMP=$G(RADESCR("FLDNAME")) "RTN","RAPSAPI2",31,0) S DIR("A")=DIR("A")_$S(TMP'="":" THE ENTIRE "_TMP,1:"")_"? " "RTN","RAPSAPI2",32,0) D ^DIR "RTN","RAPSAPI2",33,0) W:Y'=1 " " "RTN","RAPSAPI2",34,0) Q (Y=1) "RTN","RAPSAPI2",35,0) ; "RTN","RAPSAPI2",36,0) ;***** DELETES A (SUB)FILE RECORD "RTN","RAPSAPI2",37,0) ; "RTN","RAPSAPI2",38,0) ; FILE File/subfile number "RTN","RAPSAPI2",39,0) ; IENS IENS of the record "RTN","RAPSAPI2",40,0) ; "RTN","RAPSAPI2",41,0) DELETE(FILE,IENS) ; "RTN","RAPSAPI2",42,0) N RAFDA,RAMSG "RTN","RAPSAPI2",43,0) S RAFDA(FILE,IENS,.01)="@" "RTN","RAPSAPI2",44,0) D FILE^DIE(,"RAFDA","RAMSG") "RTN","RAPSAPI2",45,0) Q "RTN","RAPSAPI2",46,0) ; "RTN","RAPSAPI2",47,0) ;***** DISPLAYS HELP (? and ??) "RTN","RAPSAPI2",48,0) ; "RTN","RAPSAPI2",49,0) ; VAL User input ("?" or "??") "RTN","RAPSAPI2",50,0) ; "RTN","RAPSAPI2",51,0) ; FILE File number "RTN","RAPSAPI2",52,0) ; "RTN","RAPSAPI2",53,0) ; FIELD Field number "RTN","RAPSAPI2",54,0) ; "RTN","RAPSAPI2",55,0) ; [IENS] IENS of the multiple defined by the FIELD parameter "RTN","RAPSAPI2",56,0) ; (1st comma piece should be empty). Specify this "RTN","RAPSAPI2",57,0) ; parameter if help information for a "Select..." "RTN","RAPSAPI2",58,0) ; prompt is needed. "RTN","RAPSAPI2",59,0) ; "RTN","RAPSAPI2",60,0) HELP(VAL,FILE,FIELD,IENS) ; "RTN","RAPSAPI2",61,0) Q:'($G(VAL)?1"?".1"?") "RTN","RAPSAPI2",62,0) N LM,RABUF,RAMSG,TMP "RTN","RAPSAPI2",63,0) S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER" "RTN","RAPSAPI2",64,0) D FIELD^DID(FILE,FIELD,,TMP,"RABUF","RAMSG") "RTN","RAPSAPI2",65,0) Q:$G(RABUF("LABEL"))="" "RTN","RAPSAPI2",66,0) ;--- "RTN","RAPSAPI2",67,0) I $G(RABUF("MULTIPLE-VALUED")) D S LM=9 "RTN","RAPSAPI2",68,0) . S FILE=+$G(RABUF("SPECIFIER")),FIELD=.01 "RTN","RAPSAPI2",69,0) . S TMP=$$ROOT^DILFD(FILE,$G(IENS),1) "RTN","RAPSAPI2",70,0) . D:TMP'="" HLPMULT(VAL,TMP,RABUF("LABEL")) "RTN","RAPSAPI2",71,0) E S LM=5 "RTN","RAPSAPI2",72,0) ;--- "RTN","RAPSAPI2",73,0) I VAL="?" D "RTN","RAPSAPI2",74,0) . D HLPROMPT(LM,FILE,FIELD) "RTN","RAPSAPI2",75,0) E D HLPDESCR(9,FILE,FIELD) "RTN","RAPSAPI2",76,0) ;--- "RTN","RAPSAPI2",77,0) W ! "RTN","RAPSAPI2",78,0) Q "RTN","RAPSAPI2",79,0) ; "RTN","RAPSAPI2",80,0) ;***** DISPLAYS FIELD DESCRIPTION "RTN","RAPSAPI2",81,0) ; "RTN","RAPSAPI2",82,0) ; LM Left margin for the output "RTN","RAPSAPI2",83,0) ; "RTN","RAPSAPI2",84,0) ; FILE File number "RTN","RAPSAPI2",85,0) ; "RTN","RAPSAPI2",86,0) ; FIELD Field number "RTN","RAPSAPI2",87,0) ; "RTN","RAPSAPI2",88,0) HLPDESCR(LM,FILE,FIELD) ; "RTN","RAPSAPI2",89,0) N I,RAHLP,RAMSG "RTN","RAPSAPI2",90,0) S I=$$GET1^DID(FILE,FIELD,,"DESCRIPTION","RAHLP","RAMSG") "RTN","RAPSAPI2",91,0) D:$D(RAHLP)>1 HLPWR(LM,.RAHLP) "RTN","RAPSAPI2",92,0) Q "RTN","RAPSAPI2",93,0) ; "RTN","RAPSAPI2",94,0) ;***** DISPLAYS CONTENT OF THE MULTIPLE AND RELATED PROMPTS "RTN","RAPSAPI2",95,0) ; "RTN","RAPSAPI2",96,0) ; VAL User input ("?" or "??") "RTN","RAPSAPI2",97,0) ; "RTN","RAPSAPI2",98,0) ; LM Left margin for the output "RTN","RAPSAPI2",99,0) ; "RTN","RAPSAPI2",100,0) ; RAROOT Closed root of the multiple's sub-file "RTN","RAPSAPI2",101,0) ; "RTN","RAPSAPI2",102,0) ; MLTNAME Name of the multiple "RTN","RAPSAPI2",103,0) ; "RTN","RAPSAPI2",104,0) HLPMULT(VAL,RAROOT,MLTNAME) ; "RTN","RAPSAPI2",105,0) N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DO,DUOUT,RA50IEN,RAI,RARC,RAY,TMP,X,Y "RTN","RAPSAPI2",106,0) S RARC=0 "RTN","RAPSAPI2",107,0) I $O(@RAROOT@(0))>0 D Q:RARC "RTN","RAPSAPI2",108,0) . ;--- Get confirmation if the multiple contains more than 10 records "RTN","RAPSAPI2",109,0) . S DIC=$$OREF^DILF(RAROOT),DIC(0)="" "RTN","RAPSAPI2",110,0) . D DO^DIC1 "RTN","RAPSAPI2",111,0) . I VAL'="??",$P(DO,U,4)>10 D I 'Y S RARC=1 Q "RTN","RAPSAPI2",112,0) . . K DIR S DIR(0)="YAO" "RTN","RAPSAPI2",113,0) . . S DIR("A")="Do you want the entire "_$P(DO,U,4)_"-Entry "_MLTNAME_" List? " "RTN","RAPSAPI2",114,0) . . D ^DIR "RTN","RAPSAPI2",115,0) . ;--- Write related prompts "RTN","RAPSAPI2",116,0) . S RAY=$Y-1 "RTN","RAPSAPI2",117,0) . W !?4,$S(VAL="?":"Answer with "_MLTNAME,1:"") "RTN","RAPSAPI2",118,0) . W !?3,"Choose from:" "RTN","RAPSAPI2",119,0) . ;--- Write content of the multiple "RTN","RAPSAPI2",120,0) . S RAI=0 "RTN","RAPSAPI2",121,0) . F S RAI=$O(@RAROOT@(RAI)) Q:RAI'>0 D Q:'RAI "RTN","RAPSAPI2",122,0) . . S RA50IEN=+$P($G(@RAROOT@(RAI,0)),U) "RTN","RAPSAPI2",123,0) . . I ($Y-RAY)'1 S RAI="" D "RTN","RAPSAPI2",172,0) . F S RAI=$O(TEXT(RAI)) Q:RAI="" S X=TEXT(RAI) D ^DIWP "RTN","RAPSAPI2",173,0) E S X=$G(TEXT) D ^DIWP "RTN","RAPSAPI2",174,0) D ^DIWW "RTN","RAPSAPI2",175,0) K ^UTILITY($J,"W") "RTN","RAPSAPI2",176,0) Q "RTN","RAPSAPI2",177,0) ; "RTN","RAPSAPI2",178,0) ;***** VALIDATES DIRECT IEN INPUT (i.e. `IEN) "RTN","RAPSAPI2",179,0) ; "RTN","RAPSAPI2",180,0) ; .VAL User input (`IEN) "RTN","RAPSAPI2",181,0) ; "RTN","RAPSAPI2",182,0) ; Return values: "RTN","RAPSAPI2",183,0) ; 0 Ignore the input "RTN","RAPSAPI2",184,0) ; 1 Process the input "RTN","RAPSAPI2",185,0) ; "RTN","RAPSAPI2",186,0) ; Note: This is an internal function. Do not call it from outside "RTN","RAPSAPI2",187,0) ; of the RAPSAPI3 routine. "RTN","RAPSAPI2",188,0) ; "RTN","RAPSAPI2",189,0) IEN(VAL) ; "RTN","RAPSAPI2",190,0) N IEN,RADIC,PSSDIY "RTN","RAPSAPI2",191,0) S IEN=+$P(VAL,"`",2,$L(VAL)) "RTN","RAPSAPI2",192,0) I IEN'>0 W "??" Q 0 "RTN","RAPSAPI2",193,0) S VAL="`"_IEN "RTN","RAPSAPI2",194,0) ;--- Check the multiple "RTN","RAPSAPI2",195,0) Q:$D(@(RADESCR("ROOT"))@(IEN)) 1 "RTN","RAPSAPI2",196,0) ;--- Check the DRUG file (#50) "RTN","RAPSAPI2",197,0) S RADIC="^PSDRUG(",RADIC(0)="" "RTN","RAPSAPI2",198,0) D SETVACL(RADESCR) "RTN","RAPSAPI2",199,0) D DIC^PSSDI(50,"RA",.RADIC,VAL,,RADESCR("SCRDATE"),,.RAVACL) "RTN","RAPSAPI2",200,0) W:Y'>0 "??" "RTN","RAPSAPI2",201,0) Q (Y>0) "RTN","RAPSAPI2",202,0) ; "RTN","RAPSAPI2",203,0) ;***** SELECTS A RECORD FROM THE MULTIPLE "RTN","RAPSAPI2",204,0) ; "RTN","RAPSAPI2",205,0) ; NODE Node of the cross-reference "RTN","RAPSAPI2",206,0) ; MLTNAME Name of the multiple "RTN","RAPSAPI2",207,0) ; DRUGNAME Drug name "RTN","RAPSAPI2",208,0) ; "RTN","RAPSAPI2",209,0) ; Return values: "RTN","RAPSAPI2",210,0) ; 0 No selection "RTN","RAPSAPI2",211,0) ; >0 IEN of a multiple's record "RTN","RAPSAPI2",212,0) ; "RTN","RAPSAPI2",213,0) MULTSEL(NODE,MLTNAME,DRUGNAME) ; "RTN","RAPSAPI2",214,0) N CNT,DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAI,RATMP,RC,TMP,X,Y "RTN","RAPSAPI2",215,0) S RATMP=$NA(^TMP($J,$T(+0)_"-MULTSEL")) K @RATMP "RTN","RAPSAPI2",216,0) ;=== "RTN","RAPSAPI2",217,0) S (CNT,IEN,RC)=0 "RTN","RAPSAPI2",218,0) F D Q:RC!(IEN'>0) "RTN","RAPSAPI2",219,0) . ;--- Display the next portion of records "RTN","RAPSAPI2",220,0) . F RAI=1:1:5 S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D "RTN","RAPSAPI2",221,0) . . S CNT=CNT+1,@RATMP@(CNT)=IEN "RTN","RAPSAPI2",222,0) . . W !?5,CNT,?9,DRUGNAME "RTN","RAPSAPI2",223,0) . Q:CNT'>0 "RTN","RAPSAPI2",224,0) . ;--- Ask the user "RTN","RAPSAPI2",225,0) . K DIR S DIR(0)="NAO^1:"_CNT_":0" "RTN","RAPSAPI2",226,0) . S DIR("A")="CHOOSE 1-"_CNT_": " "RTN","RAPSAPI2",227,0) . I IEN>0 D:$O(@NODE@(IEN))>0 "RTN","RAPSAPI2",228,0) . . S DIR("A",1)="Press to see more, '^' to exit this list, OR" "RTN","RAPSAPI2",229,0) . S DIR("?")="Select a record of the "_MLTNAME_" multivalued field." "RTN","RAPSAPI2",230,0) . D ^DIR "RTN","RAPSAPI2",231,0) . I $D(DTOUT)!$D(DUOUT) S RC=-1 Q "RTN","RAPSAPI2",232,0) . S:X'="" IEN=+@RATMP@(+Y),RC=1 "RTN","RAPSAPI2",233,0) ;=== Cleanup "RTN","RAPSAPI2",234,0) K @RATMP "RTN","RAPSAPI2",235,0) Q $S(RC>0:IEN,1:0) "RTN","RAPSAPI2",236,0) ; "RTN","RAPSAPI2",237,0) ;***** INITIALIZES THE RAVACL ARRAY FOR SCREENING MEDS "RTN","RAPSAPI2",238,0) ; "RTN","RAPSAPI2",239,0) ; FLAGS Mode flags "RTN","RAPSAPI2",240,0) ; "RTN","RAPSAPI2",241,0) SETVACL(FLAGS) ; "RTN","RAPSAPI2",242,0) N I "RTN","RAPSAPI2",243,0) F I="DX200","DX201","DX202" S RAVACL(I)="" "RTN","RAPSAPI2",244,0) S:FLAGS["P" RAVACL("P")="" "RTN","RAPSAPI2",245,0) S:FLAGS["R" RAVACL("R")="" "RTN","RAPSAPI2",246,0) Q "RTN","RAPSAPI3") 0^15^B59625794^n/a "RTN","RAPSAPI3",1,0) RAPSAPI3 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/13/07 10:45am "RTN","RAPSAPI3",2,0) ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8 "RTN","RAPSAPI3",3,0) ; "RTN","RAPSAPI3",4,0) ; This routine uses the following IAs: "RTN","RAPSAPI3",5,0) ; "RTN","RAPSAPI3",6,0) ; #2056 GET1^DIQ "RTN","RAPSAPI3",7,0) ; #2052 FIELD^DID "RTN","RAPSAPI3",8,0) ; #2055 ROOT^DILFD "RTN","RAPSAPI3",9,0) ; #10007 DO^DIC1 "RTN","RAPSAPI3",10,0) ; #4551 DIC^PSSDI looks up & screens records from file #50 "RTN","RAPSAPI3",11,0) ; "RTN","RAPSAPI3",12,0) Q "RTN","RAPSAPI3",13,0) ; "RTN","RAPSAPI3",14,0) ;***** RETURNS IEN OF THE DEFAULT RECORD OF THE MULTIPLE "RTN","RAPSAPI3",15,0) ; "RTN","RAPSAPI3",16,0) ; Note: This is an internal function. Do not call it from outside "RTN","RAPSAPI3",17,0) ; of this routine. "RTN","RAPSAPI3",18,0) ; "RTN","RAPSAPI3",19,0) DFLTREC() ; "RTN","RAPSAPI3",20,0) Q $S($G(RADESCR("SELCNT"))'>1:+$O(@(RADESCR("ROOT"))@(" "),-1),1:0) "RTN","RAPSAPI3",21,0) ; "RTN","RAPSAPI3",22,0) ;***** EDITS RADIOLOGY SCREENED POINTER TO THE DRUG FILE (#50) "RTN","RAPSAPI3",23,0) ; "RTN","RAPSAPI3",24,0) ; RADESCR Flags that control execution "RTN","RAPSAPI3",25,0) ; "P" Medications "RTN","RAPSAPI3",26,0) ; "R" Radiopharms "RTN","RAPSAPI3",27,0) ; "RTN","RAPSAPI3",28,0) ; RAIENS IENS of the edited record (e.g. "1,") "RTN","RAPSAPI3",29,0) ; "RTN","RAPSAPI3",30,0) ; RAFILE Radiology file number (e.g. 71.9) "RTN","RAPSAPI3",31,0) ; "RTN","RAPSAPI3",32,0) ; RAFIELD Field number of the pointer to the file #50 (e.g. 5) "RTN","RAPSAPI3",33,0) ; "RTN","RAPSAPI3",34,0) ; [RADATE] Date for screening medications "RTN","RAPSAPI3",35,0) ; "RTN","RAPSAPI3",36,0) ; Return values: "RTN","RAPSAPI3",37,0) ; "" Field was empty and the value has not changed "RTN","RAPSAPI3",38,0) ; "@" Clear the field "RTN","RAPSAPI3",39,0) ; "^" Exit the record editing "RTN","RAPSAPI3",40,0) ; ^Field "^"-jump to other field (e.g. "^KIT") "RTN","RAPSAPI3",41,0) ; `IEN Pointer to the record of the file #50 (e.g. "`234") "RTN","RAPSAPI3",42,0) ; "RTN","RAPSAPI3",43,0) RXEDIT(RADESCR,RAIENS,RAFILE,RAFIELD,RADATE) ; "RTN","RAPSAPI3",44,0) N PSSDIY,RA50IEN,RABUF,RADIC,RAENTRY,RALABEL,RAMSG,RARC,RAVACL,TMP "RTN","RAPSAPI3",45,0) ;=== Validate and parse parameters "RTN","RAPSAPI3",46,0) S RADESCR=$G(RADESCR) "RTN","RAPSAPI3",47,0) S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P" "RTN","RAPSAPI3",48,0) S:$G(RADATE)'>0 RADATE="" "RTN","RAPSAPI3",49,0) ; "RTN","RAPSAPI3",50,0) ;=== Get field info from the data dictionary "RTN","RAPSAPI3",51,0) D FIELD^DID(RAFILE,RAFIELD,,"LABEL;MULTIPLE-VALUED","RABUF","RAMSG") "RTN","RAPSAPI3",52,0) I $G(RABUF("MULTIPLE-VALUED")) S TMP=$T(+0) D Q "^" "RTN","RAPSAPI3",53,0) . W !!,"$$RXEDIT^"_TMP_" cannot be used for multiples!" "RTN","RAPSAPI3",54,0) . W !,"Use $$RXMEDIT^"_TMP_" instead.",! "RTN","RAPSAPI3",55,0) S RALABEL=RABUF("LABEL")_": " "RTN","RAPSAPI3",56,0) K RABUF "RTN","RAPSAPI3",57,0) ; "RTN","RAPSAPI3",58,0) ;=== "RTN","RAPSAPI3",59,0) F D Q:$D(RARC) "RTN","RAPSAPI3",60,0) . ;--- Get the current internal value of the field "RTN","RAPSAPI3",61,0) . S RA50IEN=+$$GET1^DIQ(RAFILE,RAIENS,RAFIELD,"I",,"RAMSG") "RTN","RAPSAPI3",62,0) . ;--- Get the external value of the field "RTN","RAPSAPI3",63,0) . I RA50IEN>0 D "RTN","RAPSAPI3",64,0) . . S TMP=$$EN1^RAPSAPI(RA50IEN,.01) "RTN","RAPSAPI3",65,0) . . S:TMP="" TMP=RA50IEN "RTN","RAPSAPI3",66,0) . E S TMP="" "RTN","RAPSAPI3",67,0) . ;--- Display the prompt and get a user response "RTN","RAPSAPI3",68,0) . W !,RALABEL_$S(TMP'="":TMP_"// ",1:"") "RTN","RAPSAPI3",69,0) . R RAENTRY:DTIME E S RARC="^" Q "RTN","RAPSAPI3",70,0) . ;--- Keep the current value "RTN","RAPSAPI3",71,0) . I RAENTRY="" S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"") Q "RTN","RAPSAPI3",72,0) . ;--- Exit or "^"-jump "RTN","RAPSAPI3",73,0) . I RAENTRY?1"^".E S RARC=RAENTRY Q "RTN","RAPSAPI3",74,0) . ;--- @ entered "RTN","RAPSAPI3",75,0) . I RAENTRY="@" S:$$DELCONF^RAPSAPI2(+RAIENS,RA50IEN) RARC="@" Q "RTN","RAPSAPI3",76,0) . ;--- ? or ?? entered "RTN","RAPSAPI3",77,0) . D:RAENTRY?1"?".1"?" HELP^RAPSAPI2(RAENTRY,RAFILE,RAFIELD) "RTN","RAPSAPI3",78,0) . ;--- Something else entered "RTN","RAPSAPI3",79,0) . S RADIC="^PSDRUG(",RADIC(0)="EQMZ",RADIC("A")=RALABEL "RTN","RAPSAPI3",80,0) . D SETVACL^RAPSAPI2(RADESCR) "RTN","RAPSAPI3",81,0) . D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADATE,,.RAVACL) "RTN","RAPSAPI3",82,0) . S:Y>0 RARC="`"_(+Y) "RTN","RAPSAPI3",83,0) ; "RTN","RAPSAPI3",84,0) ;=== "RTN","RAPSAPI3",85,0) Q RARC "RTN","RAPSAPI3",86,0) ; "RTN","RAPSAPI3",87,0) ;***** EDITS .01 POINTER (MULTIPLE) TO THE DRUG FILE (#50) "RTN","RAPSAPI3",88,0) ; "RTN","RAPSAPI3",89,0) ; .RADESCR( Flags that control execution "RTN","RAPSAPI3",90,0) ; "P" Medications "RTN","RAPSAPI3",91,0) ; "R" Radiopharms "RTN","RAPSAPI3",92,0) ; "RTN","RAPSAPI3",93,0) ; When this function finishes editing the multiple, "RTN","RAPSAPI3",94,0) ; this parameter is KILL'ed automatically. "RTN","RAPSAPI3",95,0) ; "RTN","RAPSAPI3",96,0) ; Subscripts of this parameter store the state between "RTN","RAPSAPI3",97,0) ; calls. Do not access them outside of this function! "RTN","RAPSAPI3",98,0) ; The only exception is the RADESCR("RESULT") that "RTN","RAPSAPI3",99,0) ; stores the latest value returned by the function. "RTN","RAPSAPI3",100,0) ; "RTN","RAPSAPI3",101,0) ; "EDITONLY") The function is in "edit-only" mode of the .01 field "RTN","RAPSAPI3",102,0) ; of the multiple. "RTN","RAPSAPI3",103,0) ; "RTN","RAPSAPI3",104,0) ; "FLDNAME") Name of the .01 field of the multiple "RTN","RAPSAPI3",105,0) ; "MLTNAME") Name of the multiple "RTN","RAPSAPI3",106,0) ; "RESULT") The latest result returned by this function "RTN","RAPSAPI3",107,0) ; "ROOT") Closed root of the multiple's sub-file "RTN","RAPSAPI3",108,0) ; "SCRDATE") Date for screening meds (value of the RADATE param.) "RTN","RAPSAPI3",109,0) ; "RTN","RAPSAPI3",110,0) ; "SELCNT") Number of times the function was called in selection "RTN","RAPSAPI3",111,0) ; mode ($G("EDITONLY")=0) without resetting the state. "RTN","RAPSAPI3",112,0) ; "RTN","RAPSAPI3",113,0) ; "SUBFILE") Number of the multiple's sub-file "RTN","RAPSAPI3",114,0) ; "RTN","RAPSAPI3",115,0) ; RAIENS IENS of a multiple/subfile (e.g. ",1,") or IENS "RTN","RAPSAPI3",116,0) ; of a record of the multiple (e.g. "2,3,"). In the "RTN","RAPSAPI3",117,0) ; latter case, the function switches to "edit-only" "RTN","RAPSAPI3",118,0) ; mode. "RTN","RAPSAPI3",119,0) ; "RTN","RAPSAPI3",120,0) ; [RAFILE] Radiology file number (e.g. 70.2) "RTN","RAPSAPI3",121,0) ; "RTN","RAPSAPI3",122,0) ; [RAMULT] Field number of the multiple (e.g. 100) "RTN","RAPSAPI3",123,0) ; "RTN","RAPSAPI3",124,0) ; [RADATE] Date for screening medications "RTN","RAPSAPI3",125,0) ; "RTN","RAPSAPI3",126,0) ; Return values: "RTN","RAPSAPI3",127,0) ; "" Exit the multiple "RTN","RAPSAPI3",128,0) ; "@" Delete the value of the .01 field "RTN","RAPSAPI3",129,0) ; "^" Exit the record editing "RTN","RAPSAPI3",130,0) ; ^Field "^"-jump to other field (e.g. "^KIT") "RTN","RAPSAPI3",131,0) ; `IEN Pointer to the record of the file #50 or IEN of "RTN","RAPSAPI3",132,0) ; an existing record of the multiple (e.g. "`234") "RTN","RAPSAPI3",133,0) ; "RTN","RAPSAPI3",134,0) RXMEDIT(RADESCR,RAIENS,RAFILE,RAMULT,RADATE) ; "RTN","RAPSAPI3",135,0) N RASUBIEN ; IEN of the record of the multiple "RTN","RAPSAPI3",136,0) ; "RTN","RAPSAPI3",137,0) N PSSDIY,RA50IEN,RADEFDIS,RADEFVAL,RADIC,RADUP,RAENTRY,RAMIEN,RAMSG,RARC,RAVACL,RAXNODE,TMP "RTN","RAPSAPI3",138,0) ;=== Validate and parse parameters "RTN","RAPSAPI3",139,0) S RADESCR=$G(RADESCR) "RTN","RAPSAPI3",140,0) S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P" "RTN","RAPSAPI3",141,0) S RASUBIEN=+$P(RAIENS,","),$P(RAIENS,",")="" "RTN","RAPSAPI3",142,0) ; "RTN","RAPSAPI3",143,0) ;=== Get file/field info from the data dictionary "RTN","RAPSAPI3",144,0) I '$G(RADESCR("SELCNT")) D I $D(RARC) K RADESCR Q RARC "RTN","RAPSAPI3",145,0) . N RABUF,SUBFILE "RTN","RAPSAPI3",146,0) . S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER" "RTN","RAPSAPI3",147,0) . D FIELD^DID(RAFILE,RAMULT,,TMP,"RABUF","RAMSG") "RTN","RAPSAPI3",148,0) . ;--- "RTN","RAPSAPI3",149,0) . I '$G(RABUF("MULTIPLE-VALUED")) S TMP=$T(+0) D S RARC="^" Q "RTN","RAPSAPI3",150,0) . . W !!,"$$RXMEDIT^"_TMP_" cannot be used for single-value fields!" "RTN","RAPSAPI3",151,0) . . W !,"Use $$RXEDIT^"_TMP_" instead.",! "RTN","RAPSAPI3",152,0) . ;--- "RTN","RAPSAPI3",153,0) . S RADESCR("MLTNAME")=RABUF("LABEL") "RTN","RAPSAPI3",154,0) . S (RADESCR("SUBFILE"),SUBFILE)=+RABUF("SPECIFIER") "RTN","RAPSAPI3",155,0) . S RADESCR("FLDNAME")=$$GET1^DID(SUBFILE,.01,,"LABEL",,"RAMSG") "RTN","RAPSAPI3",156,0) . S RADESCR("ROOT")=$$ROOT^DILFD(SUBFILE,RAIENS,1) "RTN","RAPSAPI3",157,0) . S RADESCR("SCRDATE")=$S($G(RADATE)>0:+RADATE,1:"") "RTN","RAPSAPI3",158,0) ; "RTN","RAPSAPI3",159,0) ;=== Determine the execution mode "RTN","RAPSAPI3",160,0) I RASUBIEN'>0 D K RADESCR("EDITONLY") "RTN","RAPSAPI3",161,0) . S RADESCR("SELCNT")=$G(RADESCR("SELCNT"))+1 "RTN","RAPSAPI3",162,0) . S RASUBIEN=$$DFLTREC() "RTN","RAPSAPI3",163,0) E S RADESCR("EDITONLY")=1 "RTN","RAPSAPI3",164,0) ; "RTN","RAPSAPI3",165,0) ;=== "RTN","RAPSAPI3",166,0) F D Q:$D(RARC) "RTN","RAPSAPI3",167,0) . ;--- Get the current internal value of the .01 field "RTN","RAPSAPI3",168,0) . I RASUBIEN>0 D "RTN","RAPSAPI3",169,0) . . S TMP=RASUBIEN_RAIENS "RTN","RAPSAPI3",170,0) . . S RA50IEN=+$$GET1^DIQ(RADESCR("SUBFILE"),TMP,.01,"I",,"RAMSG") "RTN","RAPSAPI3",171,0) . E S RA50IEN=0 "RTN","RAPSAPI3",172,0) . ;--- Get the external value of the .01 field "RTN","RAPSAPI3",173,0) . I RA50IEN>0 D "RTN","RAPSAPI3",174,0) . . S RADEFVAL=$$EN1^RAPSAPI(RA50IEN,.01) "RTN","RAPSAPI3",175,0) . . S:RADEFVAL="" RADEFVAL=RA50IEN "RTN","RAPSAPI3",176,0) . E S RADEFVAL="" "RTN","RAPSAPI3",177,0) . S RADEFDIS=": "_$S(RADEFVAL'="":RADEFVAL_"// ",1:"") "RTN","RAPSAPI3",178,0) . ;--- Display the prompt and get a user response "RTN","RAPSAPI3",179,0) . W ! W:'$G(RADESCR("EDITONLY")) "Select " "RTN","RAPSAPI3",180,0) . W RADESCR("FLDNAME")_RADEFDIS "RTN","RAPSAPI3",181,0) . R RAENTRY:DTIME E S RARC="^" Q "RTN","RAPSAPI3",182,0) . ;--- Keep the current value or exit if there is no current record "RTN","RAPSAPI3",183,0) . I RAENTRY="" D Q "RTN","RAPSAPI3",184,0) . . I RASUBIEN'>0 S RARC="" Q "RTN","RAPSAPI3",185,0) . . ;--- If selecting a record, return IEN in the multiple "RTN","RAPSAPI3",186,0) . . I '$G(RADESCR("EDITONLY")) S RARC="`"_RASUBIEN Q "RTN","RAPSAPI3",187,0) . . ;--- If just editing the .01 field, return IEN in the DRUG file "RTN","RAPSAPI3",188,0) . . S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"") "RTN","RAPSAPI3",189,0) . ;--- Exit or "^"-jump "RTN","RAPSAPI3",190,0) . I RAENTRY?1"^".E S RARC=RAENTRY Q "RTN","RAPSAPI3",191,0) . ;--- @ entered "RTN","RAPSAPI3",192,0) . I RAENTRY="@" D:$$DELCONF^RAPSAPI2(RASUBIEN,RA50IEN) Q "RTN","RAPSAPI3",193,0) . . ;--- Let the FileMan delete the value of the .01 field "RTN","RAPSAPI3",194,0) . . I $G(RADESCR("EDITONLY")) S RARC="@" Q "RTN","RAPSAPI3",195,0) . . ;--- Delete the record at "Select ..." prompt "RTN","RAPSAPI3",196,0) . . D DELETE^RAPSAPI2(RADESCR("SUBFILE"),RASUBIEN_RAIENS) "RTN","RAPSAPI3",197,0) . . S RASUBIEN=$$DFLTREC() "RTN","RAPSAPI3",198,0) . ;--- Record IEN entered "RTN","RAPSAPI3",199,0) . I RAENTRY?1"`"1.N S:$$IEN^RAPSAPI2(.RAENTRY) RARC=RAENTRY Q "RTN","RAPSAPI3",200,0) . ;--- Add duplicate entry (value in double quotes) "RTN","RAPSAPI3",201,0) . I RAENTRY?1""""1.E1"""" D S RADUP=1 "RTN","RAPSAPI3",202,0) . . S RAENTRY=$E(RAENTRY,2,$L(RAENTRY)-1) ; Remove quotes "RTN","RAPSAPI3",203,0) . E S RADUP=0 "RTN","RAPSAPI3",204,0) . ;--- ? or ?? entered "RTN","RAPSAPI3",205,0) . I RAENTRY?1"?".1"?" D S RADUP=0 "RTN","RAPSAPI3",206,0) . . I $G(RADESCR("EDITONLY")) D Q "RTN","RAPSAPI3",207,0) . . . D HELP^RAPSAPI2(RAENTRY,RADESCR("SUBFILE"),.01) "RTN","RAPSAPI3",208,0) . . D HELP^RAPSAPI2(RAENTRY,RAFILE,RAMULT,RAIENS) "RTN","RAPSAPI3",209,0) . ;--- Everything else "RTN","RAPSAPI3",210,0) . S RADIC="^PSDRUG(",RADIC(0)="EQMZ" "RTN","RAPSAPI3",211,0) . S RADIC("A")=RADESCR("FLDNAME")_": " "RTN","RAPSAPI3",212,0) . D SETVACL^RAPSAPI2(RADESCR) "RTN","RAPSAPI3",213,0) . D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADESCR("SCRDATE"),,.RAVACL) "RTN","RAPSAPI3",214,0) . Q:Y'>0 "RTN","RAPSAPI3",215,0) . ;--- If just editing the .01 field, return IEN in the DRUG file "RTN","RAPSAPI3",216,0) . I $G(RADESCR("EDITONLY")) S RARC="`"_(+Y) Q "RTN","RAPSAPI3",217,0) . ;--- Try to find the drug in the multiple. "RTN","RAPSAPI3",218,0) . ;--- If not found or duplication is forced, add the drug. "RTN","RAPSAPI3",219,0) . S RAXNODE=$NA(@(RADESCR("ROOT"))@("B",+Y)) "RTN","RAPSAPI3",220,0) . S RAMIEN=+$O(@RAXNODE@(0)) "RTN","RAPSAPI3",221,0) . I (RAMIEN'>0)!RADUP S RARC="""`"_(+Y)_"""" Q "RTN","RAPSAPI3",222,0) . ;--- Otherwise, select a record from the multiple. "RTN","RAPSAPI3",223,0) . I $O(@RAXNODE@(RAMIEN))>0 D Q:RAMIEN'>0 "RTN","RAPSAPI3",224,0) . . S RAMIEN=$$MULTSEL^RAPSAPI2(RAXNODE,RADESCR("MLTNAME"),$P(Y,U,2)) "RTN","RAPSAPI3",225,0) . S RARC="`"_RAMIEN "RTN","RAPSAPI3",226,0) ; "RTN","RAPSAPI3",227,0) ;=== Cleanup "RTN","RAPSAPI3",228,0) S RADESCR("RESULT")=RARC "RTN","RAPSAPI3",229,0) D:'$G(RADESCR("EDITONLY")) "RTN","RAPSAPI3",230,0) . K:(RARC="^")!((RARC="")&(RA50IEN'>0)) RADESCR "RTN","RAPSAPI3",231,0) Q RARC "RTN","RASTREQN") 0^14^B32502575^B31958180 "RTN","RASTREQN",1,0) RASTREQN ;HIRMFO/GJC-Status Requirement check for Radiopharms ;11/18/97 15:13 "RTN","RASTREQN",2,0) ;;5.0;Radiology/Nuclear Medicine;**40,65**;Mar 16, 1998;Build 8 "RTN","RASTREQN",3,0) ; "RTN","RASTREQN",4,0) ;supported IA #10104 reference to UP^XLFSTR and REPEAT^XLFSTR "RTN","RASTREQN",5,0) ;Supported IA #2056 refernce to GETS^DIQ "RTN","RASTREQN",6,0) ; "RTN","RASTREQN",7,0) ; *** 'RASTREQN' is called from routine: 'RASTREQ' *** "RTN","RASTREQN",8,0) EN1(RADIO,RAJ) ; Check if all the required radiopharmaceutical data has "RTN","RASTREQN",9,0) ; been entered for this particular Examination Status. "RTN","RASTREQN",10,0) ; *=*=*= Kills 'X' if the status cannot be updated =*=*=* "RTN","RASTREQN",11,0) ; Input: 'RADIO' -> .5 node of the examination status (Radiopharms req) "RTN","RASTREQN",12,0) ; 'RAJ' -> 0 node of the examination "RTN","RASTREQN",13,0) ; "RTN","RASTREQN",14,0) ; NOTE: RAMES1 is set in RASTREQ^RASTREQ subroutine. Only the 'Status "RTN","RASTREQN",15,0) ; Tracking Of Exams' option displays which required fields are not "RTN","RASTREQN",16,0) ; populated for the next available Exam Status. "RTN","RASTREQN",17,0) ; "RTN","RASTREQN",18,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",19,0) ; Determine if 'Radiopharmaceutical' is required "RTN","RASTREQN",20,0) ; RAPRI defined in [RA STATUS CHANGE] & [RA EXAM EDIT] "RTN","RASTREQN",21,0) ; "RTN","RASTREQN",22,0) Q:"N"[$P(RADIO,"^") ; Rpharms & Dosages NOT Req'd (either 'no' or null) "RTN","RASTREQN",23,0) N RAPROC S RAPROC(0)=$G(^RAMIS(71,+$P(RAJ,"^",2),0)) "RTN","RASTREQN",24,0) Q:$P(RAPROC(0),"^",2)=1 ; Never ask Rpharms & Dosages "RTN","RASTREQN",25,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",26,0) N RA702 S RA702=+$P(RAJ,"^",28) ; ien in NUC MED EXAM DATA (70.2) file "RTN","RASTREQN",27,0) N RA7021,RACNT,RAI,RAMES2,RAREQ,RAZ S RAI=0 "RTN","RASTREQN",28,0) I 'RA702,($P(RADIO,"^")="Y") D Q "RTN","RASTREQN",29,0) . K X S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",30,0) . Q "RTN","RASTREQN",31,0) F S RAI=$O(^RADPTN(RA702,"NUC",RAI)) Q:RAI'>0 D "RTN","RASTREQN",32,0) . S RA7021=$G(^RADPTN(RA702,"NUC",RAI,0)),RACNT=0 "RTN","RASTREQN",33,0) . S RAMES2="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !,""Radiopharmaceutical: "",$$EN1^RAPSAPI(+$P(RA7021,""^""),.01)" "RTN","RASTREQN",34,0) . I $P(RADIO,"^")="Y",($P(RA7021,"^")=""!($P(RA7021,"^",7)="")) D "RTN","RASTREQN",35,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",36,0) .. I $P(RA7021,"^")="" S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",37,0) .. I $P(RA7021,"^",7)="" S RAZ="Dosage" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",38,0) .. Q "RTN","RASTREQN",39,0) . I $P(RADIO,"^",3)="Y",($P(RA7021,"^",4)="") D "RTN","RASTREQN",40,0) .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",41,0) .. S RAZ="Activity Drawn" X:$D(RAMES1) RAMES1 K X "RTN","RASTREQN",42,0) .. Q "RTN","RASTREQN",43,0) . I $P(RADIO,"^",4)="Y",($P(RA7021,"^",5)=""!($P(RA7021,"^",6)="")) D "RTN","RASTREQN",44,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",45,0) .. I $P(RA7021,"^",5)="" S RAZ="Date/Time Drawn" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",46,0) .. I $P(RA7021,"^",6)="" S RAZ="Person Who Measured Dose" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",47,0) .. Q "RTN","RASTREQN",48,0) . I $P(RADIO,"^",5)="Y",($P(RA7021,"^",8)=""!($P(RA7021,"^",9)="")) D "RTN","RASTREQN",49,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",50,0) .. I $P(RA7021,"^",8)="" S RAZ="Date/Time Dose Administered" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",51,0) .. I $P(RA7021,"^",9)="" S RAZ="Person Who Administered Dose" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",52,0) .. Q "RTN","RASTREQN",53,0) . I $P(RADIO,"^",7)="Y",($P(RA7021,"^",11)=""!($P(RA7021,"^",12)="")) D "RTN","RASTREQN",54,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",55,0) .. I $P(RA7021,"^",11)="" S RAZ="Route Of Administration" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",56,0) .. I $P(RA7021,"^",12)="" S RAZ="Site Of Administration" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",57,0) .. Q "RTN","RASTREQN",58,0) . I $P(RADIO,"^",8)="Y",($P(RA7021,"^",13)="") D "RTN","RASTREQN",59,0) .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",60,0) .. S RAZ="Lot No." X:$D(RAMES1) RAMES1 K X "RTN","RASTREQN",61,0) .. Q "RTN","RASTREQN",62,0) . I $P(RADIO,"^",9)="Y",($P(RA7021,"^",14)=""!($P(RA7021,"^",15)="")) D "RTN","RASTREQN",63,0) .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 "RTN","RASTREQN",64,0) .. I $P(RA7021,"^",14)="" S RAZ="Volume" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",65,0) .. I $P(RA7021,"^",15)="" S RAZ="Form" X:$D(RAMES1) RAMES1 "RTN","RASTREQN",66,0) .. Q "RTN","RASTREQN",67,0) . Q "RTN","RASTREQN",68,0) Q "RTN","RASTREQN",69,0) NORADIO(RAPRI,RANXT72) ; This function will determine if Rpharm "RTN","RASTREQN",70,0) ; fields from the 'Nuc Med Exam Data' file [ ^RADPTN( ] will be asked. "RTN","RASTREQN",71,0) ; Input : 'RANXT72' -> .6 node of the 'Next' Exam Status "RTN","RASTREQN",72,0) ; : 'RAPRI' -> IEN of the procedure for this exam "RTN","RASTREQN",73,0) ; Output: '1' bypass Rpharm questions, else (0) ask "RTN","RASTREQN",74,0) Q:$TR($$UP^XLFSTR(RANXT72(.6)),"^","")="" 1 ; null or '^'s "RTN","RASTREQN",75,0) ; ------------------- Variable Definitions ---------------------------- "RTN","RASTREQN",76,0) ; 'RAPROC(2)': ask Rpharm & Dosages parameter for this procedure "RTN","RASTREQN",77,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",78,0) N RAPROC S RAPROC(2)=$P($G(^RAMIS(71,RAPRI,0)),"^",2) "RTN","RASTREQN",79,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",80,0) ; * following conditions apply for descendants exams & single exams * "RTN","RASTREQN",81,0) ; * Number 1: Suppress Rpharm = 1 even if 'Rpharms/Dose' Req'd * "RTN","RASTREQN",82,0) ; * Number 2: Suppress Rpharm = null or 0, 'Rpharm/Dose' not req'd * "RTN","RASTREQN",83,0) Q:RAPROC(2)=1 1 "RTN","RASTREQN",84,0) Q:"N"[$P(RANXT72(.6),"^") 1 "RTN","RASTREQN",85,0) ;---------------------------------------------------------------------- "RTN","RASTREQN",86,0) Q 0 ; ask Rpharm & Dosage fields "RTN","RASTREQN",87,0) DISDEF(RADA) ; Display Radiopharmaceutical default data "RTN","RASTREQN",88,0) ; called from input templs: [RASTATUS CHANGE] and [RA EXAM EDIT] "RTN","RASTREQN",89,0) ; Input: RADA -> ien of the Nuc Med Exam Data record "RTN","RASTREQN",90,0) Q:'$O(^RADPTN(RADA,"NUC",0)) ; Radiopharms missing, no data "RTN","RASTREQN",91,0) N RADARY,RADEUC,RAFLDS,RAIENS,RAOPUT,X,Y W ! "RTN","RASTREQN",92,0) S RAIENS="" D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") "RTN","RASTREQN",93,0) F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D "RTN","RASTREQN",94,0) . Q:$P(RAIENS,",",2)="" ; top-level of the file "RTN","RASTREQN",95,0) . S (RADEUC,RAFLDS)=0 "RTN","RASTREQN",96,0) . F S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0 D Q:$D(DIRUT) "RTN","RASTREQN",97,0) .. I RAFLDS=.01 D "RTN","RASTREQN",98,0) ... S RADEUC=0 W !,$G(RADARY(70.21,RAIENS,RAFLDS,"E")) "RTN","RASTREQN",99,0) ... W !,$$REPEAT^XLFSTR("-",$L($G(RADARY(70.21,RAIENS,RAFLDS,"E")))),! "RTN","RASTREQN",100,0) ... Q "RTN","RASTREQN",101,0) .. E D "RTN","RASTREQN",102,0) ... S RADEUC=RADEUC+1 "RTN","RASTREQN",103,0) ... S RAOPUT=$$TRAN(RAFLDS)_$G(RADARY(70.21,RAIENS,RAFLDS,"E"))_$S(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"") "RTN","RASTREQN",104,0) ... W:RADEUC=1 $E(RAOPUT,1,38) W:RADEUC=2 ?39,$E(RAOPUT,1,39) "RTN","RASTREQN",105,0) ... Q "RTN","RASTREQN",106,0) .. W:RADEUC'=2&($O(RADARY(70.21,RAIENS,RAFLDS))="") ! "RTN","RASTREQN",107,0) .. W:RADEUC=2 ! S:RADEUC=2 RADEUC=0 "RTN","RASTREQN",108,0) .. Q "RTN","RASTREQN",109,0) . Q "RTN","RASTREQN",110,0) Q "RTN","RASTREQN",111,0) TRAN(X) ; Translate field name to a shorter length. "RTN","RASTREQN",112,0) Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: " "RTN","RASTREQN",113,0) Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: " "RTN","RASTREQN",114,0) Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: " "RTN","RASTREQN",115,0) Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: " "RTN","RASTREQN",116,0) Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: " "RTN","RASTREQN",117,0) Q:X=15 "Form: " "RTN","RASTREQN",118,0) VALDOS(RALOW,RAHI,X,RABACKTO,RAGOTO,RALASTAG,RAWARN) ;validate drawn/dose "RTN","RASTREQN",119,0) ; Called from [RA STATUS CHANGE] and [RA EXAM EDIT] input templates. "RTN","RASTREQN",120,0) ; Validate the value for either : "RTN","RASTREQN",121,0) ; ACTIVITY DRAWN (fld 4, DD: 70.21) "RTN","RASTREQN",122,0) ; DOSE (fld 7, DD: 70.21) "RTN","RASTREQN",123,0) ; If there are limits on the Dosage, validate. "RTN","RASTREQN",124,0) ; If validate fails, ask user if the invalid value is to be accepted. "RTN","RASTREQN",125,0) ; If yes, proceed. "RTN","RASTREQN",126,0) ; If no, re-ask DOSE. "RTN","RASTREQN",127,0) ; Input: RAHI = Upper limit on dosage "RTN","RASTREQN",128,0) ; RALOW = Lower limit on dosage "RTN","RASTREQN",129,0) ; X = Value user input "RTN","RASTREQN",130,0) ; RABACKTO = Previous Line tag to loop back to if need re-ask "RTN","RASTREQN",131,0) ; RAGOTO = Default linetag to proceed to if within range "RTN","RASTREQN",132,0) ; RALASTAG = Last linetag in this edit template if early out "RTN","RASTREQN",133,0) ; RAWARN = display/not the warning msg -- 0=no, 1=yes "RTN","RASTREQN",134,0) ; "RTN","RASTREQN",135,0) ; Output: RAY = linetag to proceed to after exiting this check "RTN","RASTREQN",136,0) ; "RTN","RASTREQN",137,0) N RAY,RAYN S RAY="" I X']"" S RAY=RAGOTO G KVAL "RTN","RASTREQN",138,0) S:RALOW=""&(RAHI="") RAY=RAGOTO "RTN","RASTREQN",139,0) S:RALOW]""&(RAHI="")&(X'RAHI) RAY=RAGOTO "RTN","RASTREQN",141,0) S:RALOW]""&(RAHI]"")&(X'RAHI) RAY=RAGOTO "RTN","RASTREQN",142,0) I RAY="" D "RTN","RASTREQN",143,0) . F D Q:RAY]"" "RTN","RASTREQN",144,0) .. I $O(^RA(79,RAMDIV,"RWARN",0)) D:RAWARN "RTN","RASTREQN",145,0) ... N I S I=0 "RTN","RASTREQN",146,0) ... F S I=$O(^RA(79,RAMDIV,"RWARN",I)) Q:I'>0 W !,$G(^(I,0)) "RTN","RASTREQN",147,0) ... Q "RTN","RASTREQN",148,0) .. E D:RAWARN "RTN","RASTREQN",149,0) ... W !,"This dose requires a written, dated and signed directive by" "RTN","RASTREQN",150,0) ... W !,"a physician." "RTN","RASTREQN",151,0) ... Q "RTN","RASTREQN",152,0) .. W !!?3,"Are you sure (Y/N)?: N//" R RAYN:DTIME "RTN","RASTREQN",153,0) .. I '$T!(RAYN["^") S RAY=RALASTAG Q "RTN","RASTREQN",154,0) .. S RAYN=$S(RAYN']"":"N",1:$$UP^XLFSTR($E(RAYN))) "RTN","RASTREQN",155,0) .. S RAY=$S(RAYN="N":RABACKTO,RAYN="Y":RAGOTO,1:"") "RTN","RASTREQN",156,0) .. I RAY="" W !!?3,"Enter 'Yes' if this value is acceptable, or 'No' if this field is to be",!?3,"re-edited.",$C(7) "RTN","RASTREQN",157,0) .. Q "RTN","RASTREQN",158,0) . Q "RTN","RASTREQN",159,0) KVAL K RABACKTO,RAGOTO,RALASTAG,RAWARN "RTN","RASTREQN",160,0) Q RAY "UP",70,70.15,-3) 70^DT "UP",70,70.15,-2) 70.02^P "UP",70,70.15,-1) 70.03^RX "UP",70,70.15,0) 70.15 "UP",70.2,70.21,-1) 70.2^NUC "UP",70.2,70.21,0) 70.21 "UP",71,71.055,-1) 71^P "UP",71,71.055,0) 71.055 "UP",71,71.08,-1) 71^NUC "UP",71,71.08,0) 71.08 "VER") 8.0^22.0 "^DD",70,70.03,200,0) MEDICATIONS^70.15PA^^RX;0 "^DD",70,70.03,200,"DT") 2961212 "^DD",70,70.15,0) MEDICATIONS SUB-FIELD^^4^3 "^DD",70,70.15,0,"NM","MEDICATIONS") "^DD",70,70.15,.01,0) MED ADMINISTERED^MP50'^PSDRUG(^0;1^Q "^DD",70,70.15,.01,1,0) ^.1 "^DD",70,70.15,.01,1,1,0) 70.15^B "^DD",70,70.15,.01,1,1,1) S ^RADPT(DA(3),"DT",DA(2),"P",DA(1),"RX","B",$E(X,1,30),DA)="" "^DD",70,70.15,.01,1,1,2) K ^RADPT(DA(3),"DT",DA(2),"P",DA(1),"RX","B",$E(X,1,30),DA) "^DD",70,70.15,.01,1,1,"DT") 3060522 "^DD",70,70.15,.01,3) Enter medication administered during this exam. "^DD",70,70.15,.01,10) Entered by system during Registration if default values exist in file 71; edited during case edit "^DD",70,70.15,.01,21,0) ^^4^4^3060522^ "^DD",70,70.15,.01,21,1,0) If any medications were administered to the patient during this exam, "^DD",70,70.15,.01,21,2,0) they may be recorded here. If medications are associated with a "^DD",70,70.15,.01,21,3,0) procedure during system set-up, the system will enter them automatically "^DD",70,70.15,.01,21,4,0) when the procedure is registered. "^DD",70,70.15,.01,"DT") 3060522 "^DD",70.2,70.2,100,0) RADIOPHARMACEUTICALS^70.21PA^^NUC;0 "^DD",70.2,70.2,100,21,0) ^.001^4^4^3060519^^^^ "^DD",70.2,70.2,100,21,1,0) If radiopharmaceutical(s) have been associated with a nuclear med "^DD",70.2,70.2,100,21,2,0) procedure, they will be automatically entered by the system when the case "^DD",70.2,70.2,100,21,3,0) is registered. Radiopharmaceuticals associated with a case may be "^DD",70.2,70.2,100,21,4,0) deleted or added during case editing. "^DD",70.2,70.21,0) RADIOPHARMACEUTICALS SUB-FIELD^^15^16 "^DD",70.2,70.21,0,"NM","RADIOPHARMACEUTICALS") "^DD",70.2,70.21,.01,0) RADIOPHARMACEUTICAL^MP50'^PSDRUG(^0;1^Q "^DD",70.2,70.21,.01,1,0) ^.1 "^DD",70.2,70.21,.01,1,1,0) 70.21^B "^DD",70.2,70.21,.01,1,1,1) S ^RADPTN(DA(1),"NUC","B",$E(X,1,30),DA)="" "^DD",70.2,70.21,.01,1,1,2) K ^RADPTN(DA(1),"NUC","B",$E(X,1,30),DA) "^DD",70.2,70.21,.01,3) Enter the radiopharmaceutical associated with this examination. "^DD",70.2,70.21,.01,21,0) ^.001^2^2^3060519^^^^ "^DD",70.2,70.21,.01,21,1,0) A radiopharmaceutical associated with this examination should be entered "^DD",70.2,70.21,.01,21,2,0) here. Radiopharm entry is mandatory for printing dosage tickets. "^DD",70.2,70.21,.01,"DT") 3060519 "^DD",71,71,50,0) DEFAULT RADIOPHARMACEUTICALS^71.08PA^^NUC;0 "^DD",71,71,50,21,0) ^.001^6^6^3060516^^^^ "^DD",71,71,50,21,1,0) Default radiopharmaceuticals and related information are edited by "^DD",71,71,50,21,2,0) ADPACs during system set-up. If default radiopharmaceutical(s) are "^DD",71,71,50,21,3,0) entered for a procedure, they will be automatically entered on the patient "^DD",71,71,50,21,4,0) record each time this procedure is registered. Information entered "^DD",71,71,50,21,5,0) by the ADPAC related to the radiopharmaceutical may appear during case "^DD",71,71,50,21,6,0) edit as a default response or may be used for edit checking. "^DD",71,71,55,0) DEFAULT MEDICATIONS^71.055PA^^P;0 "^DD",71,71,55,21,0) ^.001^5^5^3060501^^^^ "^DD",71,71,55,21,1,0) Default medication(s) may be entered by the ADPAC for a procedure. If "^DD",71,71,55,21,2,0) they are entered, the system will automatically enter them on the "^DD",71,71,55,21,3,0) patient's exam record whenever the procedure is registered. "^DD",71,71,55,21,4,0) NOTE: Default Radiopharmaceuticals may NOT be entered here; they should be "^DD",71,71,55,21,5,0) entered on a separate field. "^DD",71,71,55,"DT") 2961212 "^DD",71,71.055,0) DEFAULT MEDICATIONS SUB-FIELD^^2^2 "^DD",71,71.055,0,"NM","DEFAULT MEDICATIONS") "^DD",71,71.055,.01,0) DEFAULT MEDICATION^MP50'^PSDRUG(^0;1^Q "^DD",71,71.055,.01,1,0) ^.1 "^DD",71,71.055,.01,1,1,0) 71.055^B "^DD",71,71.055,.01,1,1,1) S ^RAMIS(71,DA(1),"P","B",$E(X,1,30),DA)="" "^DD",71,71.055,.01,1,1,2) K ^RAMIS(71,DA(1),"P","B",$E(X,1,30),DA) "^DD",71,71.055,.01,3) Enter a medication routinely used with this procedure. "^DD",71,71.055,.01,21,0) ^.001^5^5^3060501^^^^ "^DD",71,71.055,.01,21,1,0) Default medication(s) may be entered by the ADPAC for a procedure. If "^DD",71,71.055,.01,21,2,0) they are entered, the system will automatically enter them on the "^DD",71,71.055,.01,21,3,0) patient's exam record whenever the procedure is registered. "^DD",71,71.055,.01,21,4,0) NOTE: Default Radiopharmaceuticals may NOT be entered here; they should "^DD",71,71.055,.01,21,5,0) be entered on a separate field. "^DD",71,71.055,.01,"DT") 3060501 "^DD",71,71.08,0) DEFAULT RADIOPHARMACEUTICALS SUB-FIELD^^7^7 "^DD",71,71.08,0,"NM","DEFAULT RADIOPHARMACEUTICALS") "^DD",71,71.08,.01,0) DEFAULT RADIOPHARMACEUTICAL^MP50'^PSDRUG(^0;1^Q "^DD",71,71.08,.01,1,0) ^.1 "^DD",71,71.08,.01,1,1,0) 71.08^B "^DD",71,71.08,.01,1,1,1) S ^RAMIS(71,DA(1),"NUC","B",$E(X,1,30),DA)="" "^DD",71,71.08,.01,1,1,2) K ^RAMIS(71,DA(1),"NUC","B",$E(X,1,30),DA) "^DD",71,71.08,.01,3) Enter default radiopharmaceutical associated with this nuclear medicine procedure. "^DD",71,71.08,.01,10) Rad/Nuc Med ADPAC "^DD",71,71.08,.01,21,0) ^.001^7^7^3060516^^^^ "^DD",71,71.08,.01,21,1,0) The radiopharmaceutical entered here will be automatically entered as a "^DD",71,71.08,.01,21,2,0) radiopharmaceutical on patients' nuclear med exam records during "^DD",71,71.08,.01,21,3,0) registration. This information can be changed, if necessary, during case "^DD",71,71.08,.01,21,4,0) edit. If nothing is entered in this field, no radiopharmaceuticals will "^DD",71,71.08,.01,21,5,0) be automatically entered during registration for this procedure. No "^DD",71,71.08,.01,21,6,0) default radiopharmaceuticals may be used on 'parent' or 'broad' type "^DD",71,71.08,.01,21,7,0) procedures. "^DD",71,71.08,.01,"DT") 3060516 "^DD",71.9,71.9,5,0) RADIOPHARM^P50'^PSDRUG(^0;5^Q "^DD",71.9,71.9,5,3) Enter radiopharmaceutical associated with this Lot. "^DD",71.9,71.9,5,"DT") 3060501 "BLD",5857,6) ^79 **END** **END**