Released RA*5*192 SEQ #173 Extracted from mail message **KIDS**:RA*5.0*192^ **INSTALL NAME** RA*5.0*192 "BLD",12586,0) RA*5.0*192^RADIOLOGY/NUCLEAR MEDICINE^0^3220728^y "BLD",12586,1,0) ^^3^3^3220722^ "BLD",12586,1,1,0) Patch one hundred and ninety-two for the VistA Radiology/Nuclear "BLD",12586,1,2,0) Medicine 5.0 application. Please review FORUM's Patch Module description "BLD",12586,1,3,0) and installation instructions for RA*5.0*192 before installing this patch. "BLD",12586,4,0) ^9.64PA^71.1^1 "BLD",12586,4,71.1,0) 71.1 "BLD",12586,4,71.1,222) y^n^f^^^^n "BLD",12586,4,"B",71.1,71.1) "BLD",12586,6) 1 "BLD",12586,6.3) 1 "BLD",12586,"ABPKG") n "BLD",12586,"KRN",0) ^9.67PA^1.5^25 "BLD",12586,"KRN",.4,0) .4 "BLD",12586,"KRN",.401,0) .401 "BLD",12586,"KRN",.402,0) .402 "BLD",12586,"KRN",.403,0) .403 "BLD",12586,"KRN",.5,0) .5 "BLD",12586,"KRN",.84,0) .84 "BLD",12586,"KRN",1.5,0) 1.5 "BLD",12586,"KRN",1.6,0) 1.6 "BLD",12586,"KRN",1.61,0) 1.61 "BLD",12586,"KRN",1.62,0) 1.62 "BLD",12586,"KRN",3.6,0) 3.6 "BLD",12586,"KRN",3.8,0) 3.8 "BLD",12586,"KRN",9.2,0) 9.2 "BLD",12586,"KRN",9.8,0) 9.8 "BLD",12586,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",12586,"KRN",9.8,"NM",1,0) RASYNCH^^0^B15462003 "BLD",12586,"KRN",9.8,"NM",2,0) RAORDU^^0^B27467083 "BLD",12586,"KRN",9.8,"NM",3,0) RAORDC1^^0^B9917410 "BLD",12586,"KRN",9.8,"NM",4,0) RAMAIN^^0^B34283894 "BLD",12586,"KRN",9.8,"NM","B","RAMAIN",4) "BLD",12586,"KRN",9.8,"NM","B","RAORDC1",3) "BLD",12586,"KRN",9.8,"NM","B","RAORDU",2) "BLD",12586,"KRN",9.8,"NM","B","RASYNCH",1) "BLD",12586,"KRN",19,0) 19 "BLD",12586,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",12586,"KRN",19,"NM",1,0) RA USERUTL^^2 "BLD",12586,"KRN",19,"NM",2,0) RA COMPLETED EXAM ORDER SYNCH^^0 "BLD",12586,"KRN",19,"NM","B","RA COMPLETED EXAM ORDER SYNCH",2) "BLD",12586,"KRN",19,"NM","B","RA USERUTL",1) "BLD",12586,"KRN",19.1,0) 19.1 "BLD",12586,"KRN",101,0) 101 "BLD",12586,"KRN",409.61,0) 409.61 "BLD",12586,"KRN",771,0) 771 "BLD",12586,"KRN",779.2,0) 779.2 "BLD",12586,"KRN",870,0) 870 "BLD",12586,"KRN",8989.51,0) 8989.51 "BLD",12586,"KRN",8989.52,0) 8989.52 "BLD",12586,"KRN",8993,0) 8993 "BLD",12586,"KRN",8994,0) 8994 "BLD",12586,"KRN","B",.4,.4) "BLD",12586,"KRN","B",.401,.401) "BLD",12586,"KRN","B",.402,.402) "BLD",12586,"KRN","B",.403,.403) "BLD",12586,"KRN","B",.5,.5) "BLD",12586,"KRN","B",.84,.84) "BLD",12586,"KRN","B",1.5,1.5) "BLD",12586,"KRN","B",1.6,1.6) "BLD",12586,"KRN","B",1.61,1.61) "BLD",12586,"KRN","B",1.62,1.62) "BLD",12586,"KRN","B",3.6,3.6) "BLD",12586,"KRN","B",3.8,3.8) "BLD",12586,"KRN","B",9.2,9.2) "BLD",12586,"KRN","B",9.8,9.8) "BLD",12586,"KRN","B",19,19) "BLD",12586,"KRN","B",19.1,19.1) "BLD",12586,"KRN","B",101,101) "BLD",12586,"KRN","B",409.61,409.61) "BLD",12586,"KRN","B",771,771) "BLD",12586,"KRN","B",779.2,779.2) "BLD",12586,"KRN","B",870,870) "BLD",12586,"KRN","B",8989.51,8989.51) "BLD",12586,"KRN","B",8989.52,8989.52) "BLD",12586,"KRN","B",8993,8993) "BLD",12586,"KRN","B",8994,8994) "BLD",12586,"QDEF") ^^^^^^^^^^YES "BLD",12586,"QUES",0) ^9.62^^ "BLD",12586,"REQB",0) ^9.611^2^1 "BLD",12586,"REQB",2,0) RA*5.0*183^2 "BLD",12586,"REQB","B","RA*5.0*183",2) "FIA",71.1) MAJOR RAD/NUC MED AMIS CODES "FIA",71.1,0) ^RAMIS(71.1, "FIA",71.1,0,0) 71.1 "FIA",71.1,0,1) y^n^f^^^^n "FIA",71.1,0,10) "FIA",71.1,0,11) "FIA",71.1,0,"RLRO") "FIA",71.1,0,"VR") 5.0^RA "FIA",71.1,71.1) 0 "KRN",19,406,-1) 2^1 "KRN",19,406,0) RA USERUTL^User Utility Menu^^M^66481^^^^^^^ "KRN",19,406,10,0) ^19.01IP^8^8 "KRN",19,406,10,8,0) 14743^SYN "KRN",19,406,10,8,"^") RA COMPLETED EXAM ORDER SYNCH "KRN",19,406,"U") USER UTILITY MENU "KRN",19,14743,-1) 0^2 "KRN",19,14743,0) RA COMPLETED EXAM ORDER SYNCH^Synch Completed Exams with CPRS & RIS Orders^^R^^RA MGR^^^^^^RADIOLOGY/NUCLEAR MEDICINE "KRN",19,14743,1,0) ^^7^7^3220726^ "KRN",19,14743,1,1,0) The RA COMPLETED EXAM ORDER SYNCH option will allow the user to enter a "KRN",19,14743,1,2,0) case number or accession number using existing case number lookup "KRN",19,14743,1,3,0) functionality to identify radiology exams in a COMPLETE status linked to "KRN",19,14743,1,4,0) ACTIVE or COMPLETE RIS orders and ACTIVE CPRS orders. "KRN",19,14743,1,5,0) "KRN",19,14743,1,6,0) After the option is run, the RIS exam status will remain COMPLETE and the "KRN",19,14743,1,7,0) (RIS) & CPRS orders with order statuses will be updated to COMPLETE. "KRN",19,14743,25) EN^RASYNCH "KRN",19,14743,"U") SYNCH COMPLETED EXAMS WITH CPR "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",31,-1) 1^1 "PKG",31,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",31,22,0) ^9.49I^1^1 "PKG",31,22,1,0) 5.0^2980317^2981117^66481 "PKG",31,22,1,"PAH",1,0) 192^3220728 "PKG",31,22,1,"PAH",1,1,0) ^^3^3^3220728 "PKG",31,22,1,"PAH",1,1,1,0) Patch one hundred and ninety-two for the VistA Radiology/Nuclear "PKG",31,22,1,"PAH",1,1,2,0) Medicine 5.0 application. Please review FORUM's Patch Module description "PKG",31,22,1,"PAH",1,1,3,0) and installation instructions for RA*5.0*192 before installing this patch. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 4 "RTN","RAMAIN") 0^4^B34283894^B38021414 "RTN","RAMAIN",1,0) RAMAIN ;HISC/FPT,GJC,CAH AISC/MJK,RMO;VMP/PW-Utility File Maintenance ; Jul 07, 2022@10:41:55 "RTN","RAMAIN",2,0) ;;5.0;Radiology/Nuclear Medicine;**31,43,50,54,87,133,183,192**;Mar 16, 1998;Build 1 "RTN","RAMAIN",3,0) ; "RTN","RAMAIN",4,0) ; 11/15/07 BAY/KAM RA*5*87 Rem Call 205080 Option File Access "RTN","RAMAIN",5,0) 3 ;;Major AMIS Code Enter/Edit "RTN","RAMAIN",6,0) ; --- p192 "RTN","RAMAIN",7,0) L3 ;add/edit AMIS codes "RTN","RAMAIN",8,0) S DIC="^RAMIS(71.1,",DIC(0)="AELQ",DLAYGO=71.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,DDH,I,POP,DISYS Q "RTN","RAMAIN",9,0) S DA=+Y,DIE="^RAMIS(71.1,",DR=".01;2" D ^DIE "RTN","RAMAIN",10,0) K %,%W,%Y,D0,DA,DE,DQ,DIE,DR,DI,I,POP G L3 "RTN","RAMAIN",11,0) ; --- "RTN","RAMAIN",12,0) 4 ;;Film Type Enter/Edit "RTN","RAMAIN",13,0) K DD,DIC,DLAYGO,DO "RTN","RAMAIN",14,0) S DIC="^RA(78.4,",DIC(0)="AEMQL",DLAYGO=78.4 W ! D ^DIC "RTN","RAMAIN",15,0) K DD,DIC,DLAYGO,DO "RTN","RAMAIN",16,0) I +Y<0 D D Q4 Q "RTN","RAMAIN",17,0) . D DSPLNKS^RAMAIN1 "RTN","RAMAIN",18,0) . K D,DI,X,Y "RTN","RAMAIN",19,0) . Q "RTN","RAMAIN",20,0) S DA=+Y,DIE="^RA(78.4,",DR=".01;2;3;4;5;S:+X'=1 Y=""@1"";6;@1" "RTN","RAMAIN",21,0) D ^DIE S RA784=$G(^RA(78.4,DA,0)),RA784(1)=$P(RA784,U) "RTN","RAMAIN",22,0) S RA784(5)=+$P(RA784,U,4),RA784(6)=$P(RA784,U,5) "RTN","RAMAIN",23,0) I RA784(5),(RA784(6)']"") D "RTN","RAMAIN",24,0) . N DIE,DR "RTN","RAMAIN",25,0) . W !!?5,$C(7),"'"_RA784(1)_"' has been defined as a wasted film size." "RTN","RAMAIN",26,0) . W !?5,"If a particular film size is deemed as a wasted piece of" "RTN","RAMAIN",27,0) . W !?5,"film, the wasted piece of film must be associated with an" "RTN","RAMAIN",28,0) . W !?5,"unwasted piece of film." "RTN","RAMAIN",29,0) . W !!?5,"Redefining '"_RA784(1)_"' as an unwasted film size." "RTN","RAMAIN",30,0) . S DIE="^RA(78.4,",DR="5///@" D ^DIE W " Done!" "RTN","RAMAIN",31,0) . Q "RTN","RAMAIN",32,0) K %,D0,DA,DE,DQ,DIE,DR,RA784,X,Y G 4 "RTN","RAMAIN",33,0) Q4 K I,POP,DISYS,DDH "RTN","RAMAIN",34,0) Q "RTN","RAMAIN",35,0) ; "RTN","RAMAIN",36,0) 5 ;;Diagnostic Code Enter/Edit "RTN","RAMAIN",37,0) S DIC="^RA(78.3,",DIC(0)="AEMQL",DLAYGO=78.3 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,POP,I Q "RTN","RAMAIN",38,0) S DA=+Y,DIE="^RA(78.3,",DR="2:5" D ^DIE K %,D0,DA,DE,DQ,DIE,DR,I,DI G 5 "RTN","RAMAIN",39,0) ; "RTN","RAMAIN",40,0) 6 ;;Flash Card/Label Formatter "RTN","RAMAIN",41,0) I '$D(RAFLH) D ;P183 "RTN","RAMAIN",42,0) .W !!?5,">>> Exam Label/Report Header/Report Footer/Flash Card Formatter <<<" "RTN","RAMAIN",43,0) .W !!,$$CJ^XLFSTR("Note: re-compilation will remove all local modifications",$G(IOM,80)) "RTN","RAMAIN",44,0) .Q "RTN","RAMAIN",45,0) S DIC="^RA(78.2,",DIC(0)="AEMQL",DLAYGO=78.2 W ! D ^DIC K DIC,DLAYGO G Q6:Y<0 S (RAFLH,DA)=+Y,DIE="^RA(78.2,",DR="[RA FLASH CARD EDIT]" D ^DIE K DE,DQ,DIE,DR I '$D(^RA(78.2,RAFLH,0)) G Q6 "RTN","RAMAIN",46,0) S RAFMT=RAFLH,RAK=0 "RTN","RAMAIN",47,0) F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D SETFLH^RAFLH2(RAK) "RTN","RAMAIN",48,0) D CMP^RAFLH1 "RTN","RAMAIN",49,0) W !!,"<<<<<<----------------------------Column No.------------------------------>>>>>>" "RTN","RAMAIN",50,0) W !!,"0--------1---------2---------3---------4---------5---------6---------7---------8" "RTN","RAMAIN",51,0) W !,"1 0 0 0 0 0 0 0 0",! S RATEST="",RANUM=1,RAFFLF="!" D PRT^RAFLH K RAFFLF W !! G 6 "RTN","RAMAIN",52,0) Q6 S RAK=0 F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D KILFLH^RAFLH2(RAK) "RTN","RAMAIN",53,0) K %,%W,%X,%Y,D,D0,D1,DA,FL,RA787,RATEST,RAII,RAK,RAFLH,RAFMT,RANUM,X,Y "RTN","RAMAIN",54,0) K POP,I,DDH,DUOUT,DI,DISYS "RTN","RAMAIN",55,0) Q "RTN","RAMAIN",56,0) ; "RTN","RAMAIN",57,0) 7 ;;Complication Type Enter/Edit "RTN","RAMAIN",58,0) S DIC="^RA(78.1,",DIC(0)="AEMQL",DLAYGO=78.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y G Q7 "RTN","RAMAIN",59,0) S DA=+Y,DIE="^RA(78.1,",DR=".01;2" D ^DIE K %,D,D0,DA,DE,DQ,DIE,DR D Q7 G 7 "RTN","RAMAIN",60,0) Q7 K DI,DISYS,I,POP Q "RTN","RAMAIN",61,0) ; "RTN","RAMAIN",62,0) 8 ;;Sharing/Contract Agreement Entry/Edit "RTN","RAMAIN",63,0) S DIC="^DIC(34,",DIC(0)="AELMQ",DIC("A")="Select Agreement/Contract: ",DLAYGO=34 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,I,POP Q "RTN","RAMAIN",64,0) S DA=+Y,DIE="^DIC(34,",DR=".01:3" D ^DIE K %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS G 8 "RTN","RAMAIN",65,0) ; "RTN","RAMAIN",66,0) 9 ;;Standard Reports "RTN","RAMAIN",67,0) S DIC="^RA(74.1,",DIC(0)="AEMQL",DLAYGO=74.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y D Q9 Q "RTN","RAMAIN",68,0) S DA=+Y,DIE="^RA(74.1,",DR="[RA STANDARD REPORT ENTRY]" D ^DIE K %,%W,%X,%Y,C,D,D0,DA,DE,DQ,DIE,DR,X,Y D Q9 G 9 "RTN","RAMAIN",69,0) Q9 K DDH,DI,DISYS,I,J,POP "RTN","RAMAIN",70,0) Q "RTN","RAMAIN",71,0) ; "RTN","RAMAIN",72,0) 10 ;;Procedure Modifiers Entry "RTN","RAMAIN",73,0) K DD,DO,DLAYGO,DIC,DA,DINUM,X,Y "RTN","RAMAIN",74,0) ;S (DIC,DLAYGO)="^RAMIS(71.2,",DIC(0)="AEMQL" "RTN","RAMAIN",75,0) ; 11/15/07 BAY/KAM RA*5*87 Rem Call 205080 Changed next line to set DLAYGO equal to the file number instead of the file root "RTN","RAMAIN",76,0) S DIC="^RAMIS(71.2,",DLAYGO=71.2,DIC(0)="AEMQL" "RTN","RAMAIN",77,0) S DIC("A")="Select Procedure Modifier: ",DIC("W")="D PROHLP^RAMAIN" "RTN","RAMAIN",78,0) W ! D ^DIC K DIC,DLAYGO I +Y'>0 K D,X,Y,POP,I,DDH,DG,DISYS,DUOUT Q "RTN","RAMAIN",79,0) S DIE="^RAMIS(71.2,",DA=+Y,DR="3;4" D ^DIE "RTN","RAMAIN",80,0) K %W,%X,%Y,D,DIE,DO,DD,DLAYGO,DA,DR,X,Y,POP,I,D0,DI,DISYS,DQ,C G 10 "RTN","RAMAIN",81,0) ; "RTN","RAMAIN",82,0) 11 ;;Reports Distribution Edit "RTN","RAMAIN",83,0) S DIC="^RABTCH(74.3,",DIC(0)="AEMQ" W ! D ^DIC K DIC I Y<0 K D,X,Y,I,POP Q "RTN","RAMAIN",84,0) S DA=+Y,DIE="^RABTCH(74.3,",DR="[RA DISTRIBUTION EDIT]" D ^DIE K %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS,I,POP G 11 "RTN","RAMAIN",85,0) ; "RTN","RAMAIN",86,0) 12 ;;Rad/Nuc Med Procedure Message Enter/Edit "RTN","RAMAIN",87,0) S DIC="^RAMIS(71.4,",DIC(0)="AELMQ",DLAYGO=71.4 "RTN","RAMAIN",88,0) W ! D ^DIC K DIC,DLAYGO I Y<0 K D,DTOUT,DUOUT,X,Y Q "RTN","RAMAIN",89,0) S DA=+Y "RTN","RAMAIN",90,0) L +^RAMIS(71.4,DA):3 I '$T D G 12 ;*54 "RTN","RAMAIN",91,0) . K DIR S DIR(0)="EA",DIR("A")="Sorry, someone else is editing that entry. - continue " D ^DIR K DIR "RTN","RAMAIN",92,0) K RAMLNA,RAMLNB S RAMSGDA=DA ;*50 "RTN","RAMAIN",93,0) S RAMLNA=$G(^RAMIS(71.4,DA,0)) ;*50 "RTN","RAMAIN",94,0) S DIE="^RAMIS(71.4,",DR=.01 D ^DIE "RTN","RAMAIN",95,0) S RAMLNB=$G(^RAMIS(71.4,+$G(DA),0)) ;*50 "RTN","RAMAIN",96,0) I RAMLNB'=RAMLNA S DA=RAMSGDA D ORDITMS^RAMAIN3 ;*50 "RTN","RAMAIN",97,0) L -^RAMIS(71.4,RAMSGDA) ;*54 "RTN","RAMAIN",98,0) K %,%W,%X,%Y,D0,DA,DE,DQ,DR,DIE,X,Y,RAMLNA,RAMLNB,RAMSGDA "RTN","RAMAIN",99,0) G 12 "RTN","RAMAIN",100,0) ; "RTN","RAMAIN",101,0) 13 ;;Cost of Procedure Enter/Edit "RTN","RAMAIN",102,0) I '$D(RACCESS(DUZ)) D SET^RAPSET1 I $D(XQUIT) K RACCESS,XQUIT Q "RTN","RAMAIN",103,0) ; ask img type "RTN","RAMAIN",104,0) K ^TMP($J,"RA I-TYPE") D SELIMG^RAUTL7 G:$G(RAQUIT) 139 "RTN","RAMAIN",105,0) N RA0,RA1,RA2 S RA0="",RA2="" "RTN","RAMAIN",106,0) 131 S RA0=$O(^TMP($J,"RA I-TYPE",RA0)) G:RA0="" 133 "RTN","RAMAIN",107,0) 132 S RA1=$O(^TMP($J,"RA I-TYPE",RA0,0)) G:'RA1 131 "RTN","RAMAIN",108,0) S RA2=RA1_U_RA2 G 131 "RTN","RAMAIN",109,0) 133 G:RA2="" 139 S DIC="^RAMIS(71,",DIC(0)="AEMQ" "RTN","RAMAIN",110,0) ; restrict choice of procedure by img type selected "RTN","RAMAIN",111,0) S DIC("S")="I RA2[$P(^(0),U,12)" "RTN","RAMAIN",112,0) W ! D ^DIC K DIC I Y<0 K %,DTOUT,DUOUT,DIC,X,Y G 139 "RTN","RAMAIN",113,0) S DA=+Y,DIE="^RAMIS(71,",DR=10 D ^DIE "RTN","RAMAIN",114,0) K D,D0,DA,DDH,DI,DIC,DIE,DQ,DR,X "RTN","RAMAIN",115,0) G 133 "RTN","RAMAIN",116,0) 139 K ^TMP($J,"RA I-TYPE"),RAQUIT "RTN","RAMAIN",117,0) Q "RTN","RAMAIN",118,0) ; "RTN","RAMAIN",119,0) ;RA REASON EDIT /RA*5*133 "RTN","RAMAIN",120,0) 14 ;;Reason Enter/Edit "RTN","RAMAIN",121,0) S DIC="^RA(75.2,",DIC(0)="AEQL",DLAYGO=75.2 W ! D ^DIC K DIC,DLAYGO I Y<0 K DIC,DA Q "RTN","RAMAIN",122,0) I $P(^RA(75.2,+Y,0),"^",5)="Y" W !!?10,"***National standardized reason - NO EDITING!***" G 14 "RTN","RAMAIN",123,0) S DA=+Y,DIE="^RA(75.2,",DR="2:4" D ^DIE K DIE,DR,DA,Y G 14 "RTN","RAMAIN",124,0) Q "RTN","RAMAIN",125,0) PROHLP ; Help displays the modifiers and all associated imaging types. "RTN","RAMAIN",126,0) D:'$D(IOM) HOME^%ZIS "RTN","RAMAIN",127,0) N RAIT,RAIT1,RAIT2,RAIT3 Q:'+$O(^RAMIS(71.2,+Y,1,0)) ; Quit, no data "RTN","RAMAIN",128,0) S (RAIT,RAIT3)=0 "RTN","RAMAIN",129,0) F S RAIT=+$O(^RAMIS(71.2,+Y,1,RAIT)) W:'RAIT ")" Q:'RAIT D "RTN","RAMAIN",130,0) . S RAIT1=+$G(^RAMIS(71.2,+Y,1,RAIT,0)) "RTN","RAMAIN",131,0) . S RAIT2=$P($G(^RA(79.2,RAIT1,0)),"^",3) "RTN","RAMAIN",132,0) . W:($X+5)>IOM !?2 W ?$X+1 W:'RAIT3 "(" W RAIT2 S RAIT3=1 "RTN","RAMAIN",133,0) . Q "RTN","RAMAIN",134,0) Q "RTN","RAORDC1") 0^3^B9917410^B9398670 "RTN","RAORDC1",1,0) RAORDC1 ;HISC/GJC-Continuation of the RAORDC routine. ; Jul 05, 2022@11:08:24 "RTN","RAORDC1",2,0) ;;5.0;Radiology/Nuclear Medicine;**192**;Mar 16, 1998;Build 1 "RTN","RAORDC1",3,0) ; "RTN","RAORDC1",4,0) EXMCOM ; Called from EXMCOM^RAORDC, for updating request statuses for "RTN","RAORDC1",5,0) ; complete exams. "RTN","RAORDC1",6,0) K RAPRC,RACAT,RAPIFN,RARSH,RASHA,RAMIFN,RAMOD,RAMODA,RAMODD "RTN","RAORDC1",7,0) N RAPRGST S RAPRGST=$P(RAORD0,"^",13) "RTN","RAORDC1",8,0) I $P($G(RAEXM0),"^",25) D D SETU Q "RTN","RAORDC1",9,0) . N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y "RTN","RAORDC1",10,0) . S DIE="^RAO(75.1,",DR="11///Y",DA=RAOIFN D ^DIE "RTN","RAORDC1",11,0) . Q "RTN","RAORDC1",12,0) S:$P(RAEXM0,"^",2)'=$P(RAORD0,"^",2) RAPRC=$P(RAEXM0,"^",2) "RTN","RAORDC1",13,0) S:$P(RAEXM0,"^",4)'=$P(RAORD0,"^",4) RACAT=""""_$P(RAEXM0,"^",4)_"""" "RTN","RAORDC1",14,0) S RARSH=$S($P(RAORD0,"^",4)="R"&($P(RAEXM0,"^",4)'="R"):"@",$P(RAEXM0,"^",4)="R"&($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R"))):"^S X="_""""_^("R")_"""",1:"") K:RARSH="" RARSH "RTN","RAORDC1",15,0) S RASHA=$S("CS"[$P(RAORD0,"^",4)&("CS"'[$P(RAEXM0,"^",4)):"@","CS"[$P(RAEXM0,"^",4)&($P(RAEXM0,"^",9)'=""):"^S X="_$P(RAEXM0,"^",9),1:"") K:RASHA="" RASHA "RTN","RAORDC1",16,0) S:$P(RAEXM0,"^",14)'=$P(RAORD0,"^",14)&($P(RAEXM0,"^",14)) RAPIFN=$P(RAEXM0,"^",14) "RTN","RAORDC1",17,0) ; don't del/add modifiers to order file "RTN","RAORDC1",18,0) ; remove most fields from DR string to prevent chang'g them in the order "RTN","RAORDC1",19,0) S DA=RAOIFN,DIE="^RAO(75.1,",DR="11////^S X=""n""" "RTN","RAORDC1",20,0) D ^DIE K DE,DQ,DIE,DR "RTN","RAORDC1",21,0) K RAMOD F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RAMOD=$S('$D(RAMOD):$P(^(0),"^"),1:RAMOD_", "_$P(^(0),"^")) "RTN","RAORDC1",22,0) SETU ; above code is skipped if procedure is parent "RTN","RAORDC1",23,0) S $P(RABLNK," ",40)="" "RTN","RAORDC1",24,0) I $$ORVR^RAORDU()=2.5,$D(^RAO(75.1,+RAOIFN,0)),$D(^RAMIS(71,+$P(^(0),"^",2),0)) S (RAPRC,ORETURN("ORTX",1))=$E($P(^(0),"^"),1,40)_"," D "RTN","RAORDC1",25,0) .I $D(RAMOD) S ORETURN("ORTX",2)="Modifiers: "_$E(RAMOD,1,80)_"," "RTN","RAORDC1",26,0) .S ORETURN("ORTX",3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_"," "RTN","RAORDC1",27,0) .I $P(RAORD0,"^",19)]"" S X=$P(RAORD0,"^",19),ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Transport: "_$S(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_"," "RTN","RAORDC1",28,0) .I $P($G(^DPT(+RADFN,0)),"^",2)'="M" S ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"") "RTN","RAORDC1",29,0) .S ORETURN("ORIT")=$P(^RAO(75.1,+RAOIFN,0),"^",2)_";RAMIS(71," "RTN","RAORDC1",30,0) I '$D(RAF1),('$P(RAEXM0,"^",25)),($$CICHO()=1) D ; if orphan, display text now (p192) "RTN","RAORDC1",31,0) . W !?3,"...will now designate request status as 'COMPLETE'..." "RTN","RAORDC1",32,0) . Q "RTN","RAORDC1",33,0) D ^RAORDU ; Update the request status "RTN","RAORDC1",34,0) I '$D(RAF1),('$P(RAEXM0,"^",25)),($$CICHO()=1) D ; if orphan, display text now (p192) "RTN","RAORDC1",35,0) . W !?10,"...request status successfully updated." "RTN","RAORDC1",36,0) . Q "RTN","RAORDC1",37,0) Q "RTN","RAORDC1",38,0) CICHO() ;quiet - suppress output to screen? p192 "RTN","RAORDC1",39,0) ; return: 0 if $D(ZTQUEUED)#2 "RTN","RAORDC1",40,0) ; 0 if $G(RAQUIET,0)=1 "RTN","RAORDC1",41,0) ; 1 if '$D(ZTQUEUED)#2 & $G(RAQUIET)'=1 "RTN","RAORDC1",42,0) ; Note: check if RAQUIET set in EN1^RAHLO "RTN","RAORDC1",43,0) Q:$D(ZTQUEUED)#2 0 "RTN","RAORDC1",44,0) Q:$G(RAQUIET,0)=1 0 "RTN","RAORDC1",45,0) Q 1 ;don't suppress "RTN","RAORDC1",46,0) ; "RTN","RAORDU") 0^2^B27467083^B27367921 "RTN","RAORDU",1,0) RAORDU ;HISC/CAH - AISC/RMO-Update Request Status ; Jul 12, 2022@16:29:15 "RTN","RAORDU",2,0) ;;5.0;Radiology/Nuclear Medicine;**18,41,57,133,192**;Mar 16, 1998;Build 1 "RTN","RAORDU",3,0) ; last modif JULY 5,00 "RTN","RAORDU",4,0) ;The variables RAOIFN and RAOSTS must be defined. The variable "RTN","RAORDU",5,0) ;RAOREA is set when Canceling and Holding a request. The "RTN","RAORDU",6,0) ;variable RAOSCH is set when Scheduling a request. "RTN","RAORDU",7,0) ; RAOSTS=request status of exam "RTN","RAORDU",8,0) ; RAESTAT=min stat exams same dt/tm^max stat^1(if stat found) 0(else) "RTN","RAORDU",9,0) N RAESTAT "RTN","RAORDU",10,0) I RAOSTS=2,($$PARNT^RASETU(RAOIFN,RADFN)),($P($G(RAEXM0),"^",25)) D Q:RAOSTS=6 "RTN","RAORDU",11,0) . S RAESTAT=$$EN1^RASETU(RAOIFN,RADFN) "RTN","RAORDU",12,0) . S RAOSTS=$S((+RAESTAT'<1)&(+RAESTAT'>8):6,1:RAOSTS) "RTN","RAORDU",13,0) . K:RAOSTS=6 ORIFN,ORETURN "RTN","RAORDU",14,0) . I '$D(RAF1),(+RAESTAT=9),($$CICHO^RAORDC1()=1) D ;p192 "RTN","RAORDU",15,0) .. W !?3,"...will now designate request status as 'COMPLETE'..." "RTN","RAORDU",16,0) .. W !?10,"...request status successfully updated." "RTN","RAORDU",17,0) .. Q "RTN","RAORDU",18,0) . Q "RTN","RAORDU",19,0) I $D(ORSTS),ORSTS=11,$P(^RAO(75.1,RAOIFN,0),"^",5)=11 S ORIFN=+$P(^(0),"^",7),ORSTS="K",DA=RAOIFN,DIK="^RAO(75.1," D DELETE,^DIK K DIK D:ORIFN ST^ORX K ORSTS Q "RTN","RAORDU",20,0) K N I $D(RAOREA)>1 S N=$S($D(RAOIFN):RAOIFN,$D(ORPK):ORPK,1:1) I '$D(RAOREA(N)) S N=$O(RAOREA(0)) "RTN","RAORDU",21,0) S DA=RAOIFN,DIE="^RAO(75.1,",DR="10///"_$S($D(RAOREA)&(RAOSTS=1!(RAOSTS=3)):"/^S X="_$S($D(N):RAOREA(N),1:RAOREA),'$D(^RAO(75.1,RAOIFN,0)):"",$P(^(0),"^",10):"@",1:"")_";I 1;5///^S X="_RAOSTS "RTN","RAORDU",22,0) I $D(RAVSTFLG),$D(RAVLEDTI) S DR=DR_";17///^S X="_(9999999.9999-RAVLEDTI) "RTN","RAORDU",23,0) S DR=DR_";18///^S X=""NOW"";23///"_$S($D(RAOSCH)&(RAOSTS=8):"^S X="_RAOSCH,'$D(^RAO(75.1,RAOIFN,0)):"",$P(^(0),"^",23):"@",1:"") "RTN","RAORDU",24,0) S RADIV=$$SITE(),RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0))) "RTN","RAORDU",25,0) I $D(^RA(79,+RADIV,.1)),$P(^(.1),"^",19)="y" D SETLOG "RTN","RAORDU",26,0) D ^DIE K DE,DQ,DIE,DR I $$ORVR^RAORDU()=2.5 S ORIFN=$S($D(^RAO(75.1,RAOIFN,0)):+$P(^(0),"^",7),1:0),ORETURN("ORSTS")=RAOSTS D:ORIFN RETURN^ORX K ORIFN,ORETURN "RTN","RAORDU",27,0) ; "RTN","RAORDU",28,0) ; if oe/rr v.3 or greater do the following "RTN","RAORDU",29,0) ; .send a discontinue or hold message to oe/rr if request status in file "RTN","RAORDU",30,0) ; 75.1 is discontinued (1) or hold (3). "RTN","RAORDU",31,0) ; .send a complete message to oe/rr if request status in file 75.1 is "RTN","RAORDU",32,0) ; complete. "RTN","RAORDU",33,0) ; .send a scheduled message to oe/rr if request status is active (6) or "RTN","RAORDU",34,0) ; scheduled (8) AND the request was not a rollback from a status of "RTN","RAORDU",35,0) ; complete. "RTN","RAORDU",36,0) ; "RTN","RAORDU",37,0) I $$ORVR^RAORDU()'<3 D "RTN","RAORDU",38,0) . D:(RAOSTS=1)!(RAOSTS=3) EN1^RAO7CH(RAOIFN) "RTN","RAORDU",39,0) . D:RAOSTS=2 EN1^RAO7CMP(RAOIFN) "RTN","RAORDU",40,0) . I (RAOSTS=6) Q:$G(RA18PCHG,0)=1 ;P18 quit if procedure was changed - do not send "SC" message,because "XX" have been sent already "RTN","RAORDU",41,0) . I ((RAOSTS=6)!(RAOSTS=8))&($P($G(RAORDB4),"^",5)'=2) D "RTN","RAORDU",42,0) .. D EN1^RAO7SCH(RAOIFN) "RTN","RAORDU",43,0) .. Q "RTN","RAORDU",44,0) . Q "RTN","RAORDU",45,0) ; ***** PCE changes follow ***** "RTN","RAORDU",46,0) I $$PCE^RAWORK(),(RAOSTS=2),$G(RASAVDR)'="[RA OVERRIDE]" D "RTN","RAORDU",47,0) . N RA7003 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAORDU",48,0) . Q:$P(RA7003,"^",24)="Y" ; quit if clinic stop credited "RTN","RAORDU",49,0) . ;BILLING AWARE PHASE II, NO LONGER SENDING TO PTF "RTN","RAORDU",50,0) . ;I $P(RA7003,"^",6)]"",($P(^DIC(42,$P(RA7003,"^",6),0),"^",3)'="D") Q "RTN","RAORDU",51,0) . ;omit quit since both inpatient and outpatient data are sent to PCE "RTN","RAORDU",52,0) . D COMPLETE^RAPCE(RADFN,RADTI,RACNI) "RTN","RAORDU",53,0) . Q "RTN","RAORDU",54,0) ; PFSS 1B project. If the request status is discontinue then send the delete event to IBB "RTN","RAORDU",55,0) I RAOSTS=1 D DC^RABWIBB(RAOIFN) ; Requirement 8 "RTN","RAORDU",56,0) Q "RTN","RAORDU",57,0) ; "RTN","RAORDU",58,0) SETLOG K N I $D(RAOREA)>1 S N=$S($D(RAOIFN):RAOIFN,$D(ORPK):ORPK,1:1) I '$D(RAOREA(N)) S N=$O(RAOREA(0)) "RTN","RAORDU",59,0) S DR=DR_";75///^S X=$$NOW^XLFDT()",DR(2,75.12)="2////^S X="_RAOSTS_";3////^S X="_$S($G(RADUZ):RADUZ,1:DUZ)_";4///"_$S($D(RAOREA)&(RAOSTS=1!(RAOSTS=3)):"/^S X="_$S($D(N):RAOREA(N),1:RAOREA),1:"") "RTN","RAORDU",60,0) Q "RTN","RAORDU",61,0) SETORD ;Create request in OE/RR file and add OE/RR order number to file 75.1 "RTN","RAORDU",62,0) ; if oe/rr v.3 or greater send an hl7 message when creating a new request/order. "RTN","RAORDU",63,0) I $$ORVR^RAORDU()'<3 D EN1^RAO7NEW(RAOIFN) Q "RTN","RAORDU",64,0) Q:$$ORVR^RAORDU()'=2.5 "RTN","RAORDU",65,0) N RAPRGST S RAPRGST=$P(RAORD0,"^",13) "RTN","RAORDU",66,0) K RAMOD S $P(RABLNK," ",41)="" F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RAMOD=$S('$D(RAMOD):$P(^(0),"^"),1:RAMOD_", "_$P(^(0),"^")) "RTN","RAORDU",67,0) I $$ORVR^RAORDU()=2.5 S (RAPRCD,ORTX(1))=$P($G(^RAMIS(71,+$P(RAORD0,"^",2),0)),"^")_"," D "RTN","RAORDU",68,0) .I $D(RAMOD) S ORTX(2)="Modifiers: "_$E(RAMOD,1,80)_"," "RTN","RAORDU",69,0) .S ORTX(3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_"," "RTN","RAORDU",70,0) .I $P(RAORD0,"^",19)]"" S X=$P(RAORD0,"^",19),ORTX(3)=ORTX(3)_" Transport: "_$S(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_"," "RTN","RAORDU",71,0) .I $D(RASEX),RASEX'="M" S ORTX(3)=ORTX(3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"") "RTN","RAORDU",72,0) S ORIT=$P(RAORD0,"^",2)_";RAMIS(71," "RTN","RAORDU",73,0) S DIC="^RA(79.2,",DIC(0)="N",X=+$P(^RAMIS(71,+$P(RAORD0,"^",2),0),"^",12) D ^DIC K DIC,RABLNK,RAMOD,RAPRCD S ORPURG=$S(Y<0:30,$D(^RA(79.2,+Y,.1)):+$P(^(.1),"^",6),1:30) "RTN","RAORDU",74,0) S ORVP=RADFN_";DPT(",ORL=RALIFN_";SC(",ORNP=RAPIFN S ORPCL=$O(^ORD(101,"B","RA OERR EXAM",0))_";ORD(101,",ORPK=RAOIFN,ORSTS=$P(RAORD0,"^",5),ORSTRT=$P(RAORD0,"^",21) D FILE^ORX "RTN","RAORDU",75,0) I $D(ORIFN),ORIFN]"" S DA=RAOIFN,DIE="^RAO(75.1,",DR="7////^S X="_ORIFN D ^DIE K DE,DQ,DIE,DR "RTN","RAORDU",76,0) Q "RTN","RAORDU",77,0) OERR ;Set ^XUTL("OR",$J,"RA",IFN of oerr,IFN of Rad/Nuc Med order) "RTN","RAORDU",78,0) I $D(ORIFN),ORIFN,$D(RAOIFN),RAOIFN S ^XUTL("OR",$J,"RA",ORIFN,RAOIFN)=RADIV "RTN","RAORDU",79,0) K RADR1 Q "RTN","RAORDU",80,0) DELETE W:'$D(ZTQUEUED) !,"Since this order has not been released will delete instead of cancel...",! "RTN","RAORDU",81,0) Q "RTN","RAORDU",82,0) ; "RTN","RAORDU",83,0) ORVR() ;returns version number of OE/RR "RTN","RAORDU",84,0) ;returns 0 if OE/RR is not installed "RTN","RAORDU",85,0) ; "RTN","RAORDU",86,0) ;Q 3.0 ;for testing purposes "RTN","RAORDU",87,0) Q $S('$D(^ORD(100.99,0)):0,'$D(^DD(100,0,"VR")):0,1:^("VR")) "RTN","RAORDU",88,0) ; "RTN","RAORDU",89,0) ORQUIK() ;returns 1 if CPRS Order Dialogue file 101.41 exists "RTN","RAORDU",90,0) ;this means the quick order conversion to file 101.41 has been "RTN","RAORDU",91,0) ;done and users should no longer be allowed to edit quick order "RTN","RAORDU",92,0) ;parameters in the Common Procedure file 71.3. The quick order "RTN","RAORDU",93,0) ;conversion can be done prior to installing 3.0 "RTN","RAORDU",94,0) Q $S('$D(^ORD(101.41,0)):0,1:1) "RTN","RAORDU",95,0) ; "RTN","RAORDU",96,0) SITE() ; Determine the value of RADIV "RTN","RAORDU",97,0) ; +$P(RA1,"^",22)=Requesting Location "RTN","RAORDU",98,0) ; +$P(RA2,"^",15)=Division (pntr to 40.8) "RTN","RAORDU",99,0) Q:$D(RADIV)#2 RADIV "RTN","RAORDU",100,0) N RA1,RA2,RADIVSON "RTN","RAORDU",101,0) S RA1=$G(^RAO(75.1,RAOIFN,0)) "RTN","RAORDU",102,0) S RA2=$G(^SC(+$P(RA1,"^",22),0)) "RTN","RAORDU",103,0) S RADIVSON=+$$SITE^VASITE(DT,+$P(RA2,"^",15)) "RTN","RAORDU",104,0) Q $S(RADIVSON<0:0,1:RADIVSON) "RTN","RASYNCH") 0^1^B15462003^n/a "RTN","RASYNCH",1,0) RASYNCH ;HISC/GRZES - synch orders with studies ; Jul 27, 2022@16:07:17 "RTN","RASYNCH",2,0) ;;5.0;Radiology/Nuclear Medicine;**192**;Mar 16, 1998;Build 1 "RTN","RASYNCH",3,0) ; "RTN","RASYNCH",4,0) ;Routine File IA Type "RTN","RASYNCH",5,0) ;---------------------------------------------- "RTN","RASYNCH",6,0) ; 100 6475 (C) "RTN","RASYNCH",7,0) ; "RTN","RASYNCH",8,0) EN ; entry point for option "RTN","RASYNCH",9,0) ; "RTN","RASYNCH",10,0) ;new system level variables do not kill them! "RTN","RASYNCH",11,0) N RACCESS,RADIVIEN,RAIMGTY,RAMDIV,RAMDV,RAMLC,RAMSG,RAQXIT "RTN","RASYNCH",12,0) S RAMSG="Select another case number." "RTN","RASYNCH",13,0) D SET^RAPSET1 I $D(XQUIT) K XQUIT Q "RTN","RASYNCH",14,0) Q:'$D(RAIMGTY)#2 "RTN","RASYNCH",15,0) ; "RTN","RASYNCH",16,0) ;// main // "RTN","RASYNCH",17,0) ;ask the user for the case number, find accession, synch "RTN","RASYNCH",18,0) F D CASE Q:RAQXIT="^" "RTN","RASYNCH",19,0) QUIT "RTN","RASYNCH",20,0) ;// end main // "RTN","RASYNCH",21,0) ; "RTN","RASYNCH",22,0) ;// begin CASE // "RTN","RASYNCH",23,0) CASE ;get case number move forward "RTN","RASYNCH",24,0) ; Note: if user timed out or entered null var 'X' "RTN","RASYNCH",25,0) ; is set to a caret "RTN","RASYNCH",26,0) S RAQXIT=0 D ^RACNLU S (RAQXIT,X)=$G(X,"") "RTN","RASYNCH",27,0) K DIW,DIWT,RADATE,RAPRC,RARPT,RAST ;kill these vars; they're not needed. "RTN","RASYNCH",28,0) I RAQXIT="^" D QUIT "RTN","RASYNCH",29,0) .W !!,"An exam was not selected." "RTN","RASYNCH",30,0) .W !!,"Exiting the option.",! "RTN","RASYNCH",31,0) .Q "RTN","RASYNCH",32,0) ; "RTN","RASYNCH",33,0) I '$D(RADFN)!('$D(RADTI))!('$D(RADTE))!('$D(RACNI))!('$D(RACN)) D D EXIT QUIT "RTN","RASYNCH",34,0) .W !!,"The exam for this patient could not be found." "RTN","RASYNCH",35,0) .W !!,RAMSG,! "RTN","RASYNCH",36,0) .Q "RTN","RASYNCH",37,0) ; "RTN","RASYNCH",38,0) S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RASYNCH",39,0) S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RASYNCH",40,0) I RAY2=""!(RAY3="") D D EXIT Q "RTN","RASYNCH",41,0) .W !!,"The exam record for this patient is incomplete." "RTN","RASYNCH",42,0) .W !!,RAMSG,! "RTN","RASYNCH",43,0) .Q "RTN","RASYNCH",44,0) ; "RTN","RASYNCH",45,0) ;find the "ADC1" xref (if exists) and the "ADC" xref for this study "RTN","RASYNCH",46,0) S RAADC1=$P(RAY3,U,31),RAADC=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN "RTN","RASYNCH",47,0) S RAOIFN=$P(RAY3,U,11),RAXSTS=+$P(RAY3,U,3) "RTN","RASYNCH",48,0) S RAXSTS(0)=$G(^RA(72,RAXSTS,0)) "RTN","RASYNCH",49,0) I $P(RAXSTS(0),U,3)'=9!($P(RAXSTS(0),U)'="COMPLETE") D D EXIT Q ;dual conditions to be met "RTN","RASYNCH",50,0) .W !!,"Cannot synch an exam with its orders unless the status of the exam is COMPLETE." "RTN","RASYNCH",51,0) .W !!,RAMSG,! "RTN","RASYNCH",52,0) .Q "RTN","RASYNCH",53,0) ; "RTN","RASYNCH",54,0) S RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0)),RAORIFN=+$P(RAOIFN(0),U,7) ;CPRS ptr to file #100 "RTN","RASYNCH",55,0) K RAORSTS D GETS^DIQ(100,RAORIFN_",",5,"IE","RAORSTS") ;internal & external "RTN","RASYNCH",56,0) I $$GONOGO()=1 D D EXIT Q ;reference above "RTN","RASYNCH",57,0) .W !!,"Cannot synch COMPLETE exams unless they're tied to ACTIVE CPRS & ACTIVE" "RTN","RASYNCH",58,0) .W !,"or COMPLETE RIS orders.",!!,RAMSG,! "RTN","RASYNCH",59,0) .Q "RTN","RASYNCH",60,0) ; "RTN","RASYNCH",61,0) ;$$ASK() returns 1 (synch); 0 (no synch); -1 (timeout/caret(s) entered) "RTN","RASYNCH",62,0) D:$$ASK()=1 SYNCH "RTN","RASYNCH",63,0) ; "RTN","RASYNCH",64,0) EXIT ;cleanup and exit the option "RTN","RASYNCH",65,0) K %,%DT,C,DIC,DPTDFN,RAORIFN,RAORSTS,RACCESS,RACN,RACNI,RAADC,RAADC1,RADFN,RADTE,RADTI "RTN","RASYNCH",66,0) K RAHEAD,RAI,RANME,RAOIFN,RASSN,RAXSTS,RAY2,RAY3,X,Y "RTN","RASYNCH",67,0) QUIT "RTN","RASYNCH",68,0) ;// end CASE // "RTN","RASYNCH",69,0) ; "RTN","RASYNCH",70,0) ASK() ;Display the accession number for the study. Ask (yes/no) the user if they want "RTN","RASYNCH",71,0) ;to synch up active orders for this completed study. "RTN","RASYNCH",72,0) ;returns: 1 (synch); 0 (no synch); -1 (timeout/caret(s) entered) "RTN","RASYNCH",73,0) ; "RTN","RASYNCH",74,0) N RAYN K %,DIR,X,Y,DTOUT,DIROUT,DIRUT,DUOUT "RTN","RASYNCH",75,0) S DIR("A",1)="The accession number tied to this case is: '"_$S(RAADC1]"":RAADC1,1:RAADC)_"'." "RTN","RASYNCH",76,0) S DIR("A")="Would you like to proceed? ",DIR("B")="Yes" "RTN","RASYNCH",77,0) S DIR("?",1)="Enter 'Yes' to update the RIS & CPRS orders to COMPLETE or 'No' to" "RTN","RASYNCH",78,0) S DIR("?")="exit the option without updating the RIS & CPRS orders to COMPLETE." "RTN","RASYNCH",79,0) S DIR(0)="YA^" D ^DIR "RTN","RASYNCH",80,0) ;'X' is the user's unprocessed input "RTN","RASYNCH",81,0) ;'Y' is: 1 for 'Yes' & 0 for 'No' "RTN","RASYNCH",82,0) S RAYN=$S($D(DIRUT)#2!($D(DIROUT)#2):-1,1:Y) K %,DIR,X,Y,DTOUT,DIROUT,DIRUT,DUOUT "RTN","RASYNCH",83,0) Q RAYN "RTN","RASYNCH",84,0) ; "RTN","RASYNCH",85,0) GONOGO() ;Do the statuses of the CPRS and RIS orders meet the criteria "RTN","RASYNCH",86,0) ; to synch with the completed exam? "RTN","RASYNCH",87,0) ; "RTN","RASYNCH",88,0) ;CPRS: "RTN","RASYNCH",89,0) ; Global ^ORD(100.01,6,0) "RTN","RASYNCH",90,0) ; ^ORD(100.01,6,0) = "ACTIVE^actv" "RTN","RASYNCH",91,0) ;RIS: "RTN","RASYNCH",92,0) ; ^DD(75.1,5,0) = 1:DISCONTINUED;2:COMPLETE;3:HOLD;5:PENDING; "RTN","RASYNCH",93,0) ; 6:ACTIVE;8:SCHEDULED;11:UNRELEASED;13:CANCELLED; "RTN","RASYNCH",94,0) ; "RTN","RASYNCH",95,0) ; order criteria: CPRS 'active' & RIS 'active' or RIS 'complete' "RTN","RASYNCH",96,0) ; "RTN","RASYNCH",97,0) ; input: RAOIFN(0) local var; gbl scope "RTN","RASYNCH",98,0) ; RAORSTS(100) local array var; gbl scope "RTN","RASYNCH",99,0) ; return: 0 both order statuses meet the criteria "RTN","RASYNCH",100,0) ; 1 both order statuses do not meet the criteria "RTN","RASYNCH",101,0) ; "RTN","RASYNCH",102,0) Q:$G(RAORSTS(100,RAORIFN_",",5,"I"))'=6 1 "RTN","RASYNCH",103,0) Q:$P(RAOIFN(0),U,5)'=2&($P(RAOIFN(0),U,5)'=6) 1 "RTN","RASYNCH",104,0) Q 0 "RTN","RASYNCH",105,0) ; "RTN","RASYNCH",106,0) SYNCH ;synch the orders for this completed exam. "RTN","RASYNCH",107,0) ;Variables: RAOIFN,RADFN,RADTI,RADTE,RACNI,RACN set in call to RACNLU. "RTN","RASYNCH",108,0) ;RADUZ used in SETLOG^RAORDU "RTN","RASYNCH",109,0) N RADUZ,RAOSTS "RTN","RASYNCH",110,0) S RADUZ=DUZ "RTN","RASYNCH",111,0) ;update RIS & CPRS orders to COMPLETE (2) "RTN","RASYNCH",112,0) S RAOSTS=2 "RTN","RASYNCH",113,0) D ^RAORDU "RTN","RASYNCH",114,0) W !!,"Radiology order (IEN: "_RAOIFN_") request status updated to: '"_$$GET1^DIQ(75.1,RAOIFN_",",5,"","")_"'." "RTN","RASYNCH",115,0) W !,"CPRS order (IEN: "_RAORIFN_") status updated to: '"_$$GET1^DIQ(100,RAORIFN_",",5,"","")_"'." "RTN","RASYNCH",116,0) Q "RTN","RASYNCH",117,0) ; "VER") 8.0^22.2 "^DD",71.1,71.1,0) FIELD^^2^3 "^DD",71.1,71.1,0,"DDA") N "^DD",71.1,71.1,0,"DT") 3220707 "^DD",71.1,71.1,0,"IX","B",71.1,.01) "^DD",71.1,71.1,0,"NM","MAJOR RAD/NUC MED AMIS CODES") "^DD",71.1,71.1,0,"PT",71.03,.01) "^DD",71.1,71.1,0,"PT",71.1103,.01) "^DD",71.1,71.1,0,"VRPK") RADIOLOGY/NUCLEAR MEDICINE "^DD",71.1,71.1,.001,0) MAJOR AMIS CODE^NJ3,0^^ ^K:+X'=X!(X>100)!(X<1)!(X?.E1"."1N.N) X "^DD",71.1,71.1,.001,.1) MAJOR RAD/NUC MED AMIS CODE "^DD",71.1,71.1,.001,3) Type a number between 1 and 100, 0 decimal digits. "^DD",71.1,71.1,.001,10) VA MEDICAL CENTER (LOCAL) "^DD",71.1,71.1,.001,21,0) ^^5^5^3220707^ "^DD",71.1,71.1,.001,21,1,0) This field contains the number, between one and one hundred of this major "^DD",71.1,71.1,.001,21,2,0) radiology AMIS code. AMIS codes are used in the compilation of various "^DD",71.1,71.1,.001,21,3,0) workload reports, including the AMIS Report. On certain reports that are "^DD",71.1,71.1,.001,21,4,0) sorted by procedure, the sort is done on the AMIS category of the "^DD",71.1,71.1,.001,21,5,0) procedure. "^DD",71.1,71.1,.001,23,0) ^^1^1^3220707^^^^ "^DD",71.1,71.1,.001,23,1,0) This field has been updated by RA*5.0*192. "^DD",71.1,71.1,.001,"DT") 3220707 "^DD",71.1,71.1,.01,0) DESCRIPTION^RFJ50^^0;1^K:$L(X)>50!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) X "^DD",71.1,71.1,.01,.1) DESCRIPTION OF THIS MAJOR AMIS CODE "^DD",71.1,71.1,.01,1,0) ^.1 "^DD",71.1,71.1,.01,1,1,0) 71.1^B "^DD",71.1,71.1,.01,1,1,1) S ^RAMIS(71.1,"B",$E(X,1,30),DA)="" "^DD",71.1,71.1,.01,1,1,2) K ^RAMIS(71.1,"B",$E(X,1,30),DA) "^DD",71.1,71.1,.01,1,1,"%D",0) ^^1^1^3220707^ "^DD",71.1,71.1,.01,1,1,"%D",1,0) Regular 'B' cross reference assigned by FileMan. "^DD",71.1,71.1,.01,3) Answer must be 3-50 characters in length. "^DD",71.1,71.1,.01,10) VA MEDICAL CENTER (LOCAL) "^DD",71.1,71.1,.01,21,0) ^^7^7^3220707^ "^DD",71.1,71.1,.01,21,1,0) This field contains a brief description, 3-50 characters, of this AMIS code. "^DD",71.1,71.1,.01,21,2,0) AMIS codes are used in the compilation of various workload reports, "^DD",71.1,71.1,.01,21,3,0) including the AMIS Report. "^DD",71.1,71.1,.01,21,4,0) "^DD",71.1,71.1,.01,21,5,0) Since the AMIS codes are no longer assigned by the National Radiology "^DD",71.1,71.1,.01,21,6,0) Program Office (NRPO) Office, they can be added or updated at any local VA "^DD",71.1,71.1,.01,21,7,0) Medical Center. "^DD",71.1,71.1,.01,23,0) ^^1^1^3220707^ "^DD",71.1,71.1,.01,23,1,0) This field has been updated by RA*5.0*192. "^DD",71.1,71.1,.01,"DEL",1,0) I 1 D EN^DDIOL("Major AMIS codes cannot be deleted.",,"!,$C(7)") "^DD",71.1,71.1,.01,"DT") 3220707 "^DD",71.1,71.1,2,0) WEIGHT^RNJ2,0^^0;2^K:+X'=X!(X>80)!(X<1)!(X?.E1"."1N.N) X "^DD",71.1,71.1,2,.1) WEIGHTED WORK UNIT OF THIS MAJOR AMIS CODE "^DD",71.1,71.1,2,3) Enter a number, between 1 and 80, for the weighted work unit associated with this AMIS code. "^DD",71.1,71.1,2,10) VA MEDICAL CENTER (LOCAL) "^DD",71.1,71.1,2,21,0) ^^6^6^3220707^^^^ "^DD",71.1,71.1,2,21,1,0) This field contains the weighted work unit, a number between 1 and 80, "^DD",71.1,71.1,2,21,2,0) associated with this AMIS code. These weights are used in the compilation "^DD",71.1,71.1,2,21,3,0) of various workload reports, including the AMIS Report. "^DD",71.1,71.1,2,21,4,0) "^DD",71.1,71.1,2,21,5,0) These weights are assigned by the local Radiology Department "^DD",71.1,71.1,2,21,6,0) at each VA Medical Center (VAMC). "^DD",71.1,71.1,2,23,0) ^^1^1^3220707^ "^DD",71.1,71.1,2,23,1,0) This field has been updated by RA*5.0*192. "^DD",71.1,71.1,2,"DT") 3220707 "^DIC",71.1,71.1,0) MAJOR RAD/NUC MED AMIS CODES^71.1 "^DIC",71.1,71.1,0,"GL") ^RAMIS(71.1, "^DIC",71.1,71.1,"%",0) ^1.005^1^1 "^DIC",71.1,71.1,"%",1,0) RA "^DIC",71.1,71.1,"%","B","RA",1) "^DIC",71.1,71.1,"%D",0) ^^29^29^3220707^ "^DIC",71.1,71.1,"%D",1,0) This file contains the valid AMIS codes, descriptions, and weighted work "^DIC",71.1,71.1,"%D",2,0) units as assigned by Radiology Service in VACO. The data in this file is "^DIC",71.1,71.1,"%D",3,0) used in the compilation of various workload reports including the AMIS "^DIC",71.1,71.1,"%D",4,0) Report. "^DIC",71.1,71.1,"%D",5,0) "^DIC",71.1,71.1,"%D",6,0) New entries and modifications to existing entries are no longer "^DIC",71.1,71.1,"%D",7,0) prohibited by the National Radiology Program Office (NRPO). "^DIC",71.1,71.1,"%D",8,0) "^DIC",71.1,71.1,"%D",9,0) "^DIC",71.1,71.1,"%D",10,0) Data Storage "^DIC",71.1,71.1,"%D",11,0) ------------ "^DIC",71.1,71.1,"%D",12,0) The data for the 'MAJOR RAD/NUC MED AMIS CODES' file is stored in the "^DIC",71.1,71.1,"%D",13,0) ^RAMIS(71.1, global. At the present time this file is static. There "^DIC",71.1,71.1,"%D",14,0) are no special requirements to backup or archive data in this file. "^DIC",71.1,71.1,"%D",15,0) "^DIC",71.1,71.1,"%D",16,0) "^DIC",71.1,71.1,"%D",17,0) Input Templates "^DIC",71.1,71.1,"%D",18,0) --------------- "^DIC",71.1,71.1,"%D",19,0) The package does not use any input templates associated with this "^DIC",71.1,71.1,"%D",20,0) file. "^DIC",71.1,71.1,"%D",21,0) "^DIC",71.1,71.1,"%D",22,0) "^DIC",71.1,71.1,"%D",23,0) Print Templates "^DIC",71.1,71.1,"%D",24,0) --------------- "^DIC",71.1,71.1,"%D",25,0) The package does not use any print templates associated with this "^DIC",71.1,71.1,"%D",26,0) file. "^DIC",71.1,71.1,"%D",27,0) "^DIC",71.1,71.1,"%D",28,0) "^DIC",71.1,71.1,"%D",29,0) Sort Templates "^DIC",71.1,"B","MAJOR RAD/NUC MED AMIS CODES",71.1) "BLD",12586,6) ^173 **END** **END**