Released RA*5*104 SEQ #91 Extracted from mail message **KIDS**:RA*5.0*104^ **INSTALL NAME** RA*5.0*104 "BLD",7577,0) RA*5.0*104^RADIOLOGY/NUCLEAR MEDICINE^0^3100122^y "BLD",7577,1,0) ^^1^1^3100122^ "BLD",7577,1,1,0) CORRECT ASTF/ARES X-REF ISSUE "BLD",7577,4,0) ^9.64PA^^ "BLD",7577,6.3) 2 "BLD",7577,"KRN",0) ^9.67PA^779.2^20 "BLD",7577,"KRN",.4,0) .4 "BLD",7577,"KRN",.401,0) .401 "BLD",7577,"KRN",.402,0) .402 "BLD",7577,"KRN",.403,0) .403 "BLD",7577,"KRN",.5,0) .5 "BLD",7577,"KRN",.84,0) .84 "BLD",7577,"KRN",3.6,0) 3.6 "BLD",7577,"KRN",3.8,0) 3.8 "BLD",7577,"KRN",9.2,0) 9.2 "BLD",7577,"KRN",9.8,0) 9.8 "BLD",7577,"KRN",9.8,"NM",0) ^9.68A^2^1 "BLD",7577,"KRN",9.8,"NM",2,0) RAHLO1^^0^B64623938 "BLD",7577,"KRN",9.8,"NM","B","RAHLO1",2) "BLD",7577,"KRN",19,0) 19 "BLD",7577,"KRN",19,"NM",0) ^9.68A^^ "BLD",7577,"KRN",19.1,0) 19.1 "BLD",7577,"KRN",101,0) 101 "BLD",7577,"KRN",409.61,0) 409.61 "BLD",7577,"KRN",771,0) 771 "BLD",7577,"KRN",779.2,0) 779.2 "BLD",7577,"KRN",870,0) 870 "BLD",7577,"KRN",8989.51,0) 8989.51 "BLD",7577,"KRN",8989.52,0) 8989.52 "BLD",7577,"KRN",8994,0) 8994 "BLD",7577,"KRN","B",.4,.4) "BLD",7577,"KRN","B",.401,.401) "BLD",7577,"KRN","B",.402,.402) "BLD",7577,"KRN","B",.403,.403) "BLD",7577,"KRN","B",.5,.5) "BLD",7577,"KRN","B",.84,.84) "BLD",7577,"KRN","B",3.6,3.6) "BLD",7577,"KRN","B",3.8,3.8) "BLD",7577,"KRN","B",9.2,9.2) "BLD",7577,"KRN","B",9.8,9.8) "BLD",7577,"KRN","B",19,19) "BLD",7577,"KRN","B",19.1,19.1) "BLD",7577,"KRN","B",101,101) "BLD",7577,"KRN","B",409.61,409.61) "BLD",7577,"KRN","B",771,771) "BLD",7577,"KRN","B",779.2,779.2) "BLD",7577,"KRN","B",870,870) "BLD",7577,"KRN","B",8989.51,8989.51) "BLD",7577,"KRN","B",8989.52,8989.52) "BLD",7577,"KRN","B",8994,8994) "BLD",7577,"QUES",0) ^9.62^^ "BLD",7577,"REQB",0) ^9.611^1^1 "BLD",7577,"REQB",1,0) RA*5.0*94^1 "BLD",7577,"REQB","B","RA*5.0*94",1) "MBREQ") 0 "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) 104^3100122 "PKG",18,22,1,"PAH",1,1,0) ^^1^1^3100122 "PKG",18,22,1,"PAH",1,1,1,0) CORRECT ASTF/ARES X-REF ISSUE "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","RAHLO1") 0^2^B64623938^B64407342 "RTN","RAHLO1",1,0) RAHLO1 ;HIRMFO/GJC/BNT-File rpt (data from bridge program) ;6/25/04 11:49 "RTN","RAHLO1",2,0) ;;5.0;Radiology/Nuclear Medicine;**4,5,12,17,21,27,48,55,66,87,84,94,104**;Mar 16, 1998;Build 2 "RTN","RAHLO1",3,0) ; 12/15/2009 BAY/KAM RA*5*104 Rem Call 359702 On-line Verification issue "RTN","RAHLO1",4,0) ; 11/15/2007 BAY/KAM RA*5*87 Rem Call 216332 Correct UNDEF on null dx code "RTN","RAHLO1",5,0) ; 09/07/2005 108405 - KAM/BAY Allow Radiology to accept dx codes from Talk Technology "RTN","RAHLO1",6,0) ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx "RTN","RAHLO1",7,0) ; "RTN","RAHLO1",8,0) ;Integration Agreements "RTN","RAHLO1",9,0) ;---------------------- "RTN","RAHLO1",10,0) ;DIE(10018); ,FILE/UPDATE^DIE(2053); CREATE^WVRALINK(4793); $$NOW^XLFDT(10103) "RTN","RAHLO1",11,0) ;EN^XUSHSHP(10045) "RTN","RAHLO1",12,0) ; "RTN","RAHLO1",13,0) FILE ;Create entry in file 74 & file data (remember: U = "^") "RTN","RAHLO1",14,0) ;Lock an existing report record; quit if unsuccessful. If there is not existing record find "RTN","RAHLO1",15,0) ;the next available record number and then lock the record specific global by calling "RTN","RAHLO1",16,0) ;$$NEWIEN^RAHLTCPU @ line tag NEW1 (lock is implicit; lock set within $$NEWIEN^RAHLTCPU) "RTN","RAHLO1",17,0) ; "RTN","RAHLO1",18,0) I RARPT>0 D LOCKR^RAHLTCPU(.RAERR) Q:$D(RAERR)#2 "RTN","RAHLO1",19,0) N RAFDA,RAIENS "RTN","RAHLO1",20,0) ; "RTN","RAHLO1",21,0) I '$D(ZTQUEUED) N ZTQUEUED S ZTQUEUED="1^dummy to suppress screen displays in UP2^RAUTL1 and elsewhere" "RTN","RAHLO1",22,0) I '$D(RAQUIET) N RAQUIET S RAQUIET="1^dummy to suppress screen display in PTR^RARTE2" "RTN","RAHLO1",23,0) N RADATIME S RADATIME=$$NOW^XLFDT() I $L($P(RADATIME,".",2))>4 S RADATIME=$P(RADATIME,".",1)_"."_$E($P(RADATIME,".",2),1,4) S RADATIME=+RADATIME "RTN","RAHLO1",24,0) N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR "RTN","RAHLO1",25,0) D EN2^RAUTL20(.RAMEMARR) ; 04/30/99 always recalculate RAPRTSET "RTN","RAHLO1",26,0) ; If the report (stub/real) exists, unverify the existing report... Else create a new report "RTN","RAHLO1",27,0) I RARPT,$D(^RARPT(RARPT,0)) S RASAV=RARPT D S RARPT=RASAV K RASAV L:$D(RAERR) -^RARPT(RARPT) Q:$D(RAERR) G LOCK1 "RTN","RAHLO1",28,0) . ; must save off RARPT, RAVERF and other RA* variables because "RTN","RAHLO1",29,0) . ; they are being killed off somewhere in the 'Unverify A Report' "RTN","RAHLO1",30,0) . ; option. 'Unverify A Report' does lock the the report record in file 74! "RTN","RAHLO1",31,0) . N RADFN,RADTI,RACNI,RARPTSTS,RASSN,RADATE,RALONGCN,RAVERF "RTN","RAHLO1",32,0) . ; if report isn't a stub report, then consider it being edited "RTN","RAHLO1",33,0) . S:'$$STUB^RAEDCN1(RARPT) RAEDIT=1 ;log report receipt event as an edit event "RTN","RAHLO1",34,0) . I $D(RADENDUM)#2,($P(^RARPT(RARPT,0),U,5)="V") D Q ;back the report down from verified "RTN","RAHLO1",35,0) .. L -^RARPT(RARPT) ;unlock the report; remember we locked it right after FILE^RAHLO1 "RTN","RAHLO1",36,0) .. D UNVER^RARTE1(RARPT) ;Why the unlock above? Because UNVER^RARTE1 will lock the report "RTN","RAHLO1",37,0) .. S RARPT=RASAV ;RTK 7/28 for RARPT killed in UNVER^RARTE1 "RTN","RAHLO1",38,0) .. D LOCKR^RAHLTCPU(.RAERR) ;re-lock the report after UNVER^RARTE1 releases its lock "RTN","RAHLO1",39,0) .. Q "RTN","RAHLO1",40,0) . K:'($D(RAERR)#2) ^RARPT(RARPT,"I"),^("R"),^("H") "RTN","RAHLO1",41,0) . Q "RTN","RAHLO1",42,0) ; "RTN","RAHLO1",43,0) ; Create a new report record "RTN","RAHLO1",44,0) NEW1 N RARPT S RARPT=$$NEWIEN^RAHLTCPU() "RTN","RAHLO1",45,0) ; "RTN","RAHLO1",46,0) ;we have a new IEN and the record in locked. Now update that record using UPDATE^DIE "RTN","RAHLO1",47,0) S RAIENS(1)=RARPT,RAFDA(74,"+1,",.01)=RALONGCN,RAFDA(74,"+1,",2)=RADFN "RTN","RAHLO1",48,0) S RAFDA(74,"+1,",3)=(9999999.9999-RADTI),RAFDA(74,"+1,",4)=$P(RALONGCN,"-",2) "RTN","RAHLO1",49,0) D UPDATE^DIE("","RAFDA","RAIENS","RAERR") K RAFDA,RAIENS "RTN","RAHLO1",50,0) I $D(RAERR("DIERR"))#2 S RAERR="Error filing a new record in the RAD/NUC MED REPORTS file." L -^RARPT(RARPT) Q "RTN","RAHLO1",51,0) ; "RTN","RAHLO1",52,0) LOCK1 I $D(RAESIG) S X=RAESIG,X1=$G(RAVERF),X2=RARPT D EN^XUSHSHP S RAESIG=X "RTN","RAHLO1",53,0) K RAFDA,RAIENS S RAIENS=RARPT_"," "RTN","RAHLO1",54,0) S RAFDA(74,RAIENS,5)=RARPTSTS ; rpt status "RTN","RAHLO1",55,0) ;Verifier & Verified date will be set if RAVERF exists for new "RTN","RAHLO1",56,0) ;reports, edits, and addendums. Date rpt entered and reported date "RTN","RAHLO1",57,0) ;will be set for new reports, and not reset for edits and addendums "RTN","RAHLO1",58,0) I '($D(RAEDIT)#2),($D(RADATIME)#2) S RAFDA(74,RAIENS,6)=RADATIME ; date/time report entered "RTN","RAHLO1",59,0) I $G(RAVERF)&(RARPTSTS="V") S RAFDA(74,RAIENS,7)=RADATIME ; v'fied date/time "RTN","RAHLO1",60,0) I $D(RADATE)#2 S RAFDA(74,RAIENS,8)=RADATE ; reported date "RTN","RAHLO1",61,0) I $G(RAVERF)&(RARPTSTS="V") S RAFDA(74,RAIENS,9)=RAVERF ; v'fying phys "RTN","RAHLO1",62,0) S:$L($G(RATELENM)) RAFDA(74,RAIENS,9.1)=RATELENM ;Teleradiologist name - Patch 84 "RTN","RAHLO1",63,0) S:$L($G(RATELEPI)) RAFDA(74,RAIENS,9.2)=RATELEPI ;Teleradiologist NPI - Patch 84 "RTN","RAHLO1",64,0) S RAFDA(74,RAIENS,10)=$S($D(RAESIG)&(RARPTSTS="V"):RAESIG,1:"") ;esig "RTN","RAHLO1",65,0) S RAFDA(74,RAIENS,11)=$S($G(RATRANSC):RATRANSC,$G(RAVERF):RAVERF,1:"") ; transcriptionist "RTN","RAHLO1",66,0) ;next: status changed to 'verified' by "RTN","RAHLO1",67,0) I $G(RAVERF),(RARPTSTS="V") S RAFDA(74,RAIENS,17)=$G(^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")) "RTN","RAHLO1",68,0) D FILE^DIE("","RAFDA","RAERR") "RTN","RAHLO1",69,0) I $D(RAERR("DIERR"))#2 D L -^RARPT(RARPT) Q ;if error, unlock f74 and quit. "RTN","RAHLO1",70,0) .S RAERR="Error filing a report record data in the RAD/NUC MED REPORTS file." "RTN","RAHLO1",71,0) .;KILL THE WHOLE RECORD??? "RTN","RAHLO1",72,0) .Q "RTN","RAHLO1",73,0) ;-------------------------------------- "RTN","RAHLO1",74,0) ; "RTN","RAHLO1",75,0) ;if case is member of a print set, then create sub-recs for file #74 "RTN","RAHLO1",76,0) I RAPRTSET D "RTN","RAHLO1",77,0) .I '$D(RARPTN) N RARPTN S RARPTN=RALONGCN "RTN","RAHLO1",78,0) .N RAXIT D PTR^RARTE2 ;create corresponding subrecs in ^RARPT() "RTN","RAHLO1",79,0) .Q "RTN","RAHLO1",80,0) ;-------------------------------------- "RTN","RAHLO1",81,0) ; "RTN","RAHLO1",82,0) ;--- start FILE^DIE block for 70.03 --- "RTN","RAHLO1",83,0) ;don't file a Pri. Dx code for teleradiology reports in the released status (P84v11 bus. rule) "RTN","RAHLO1",84,0) S RARELTEL=$S(($D(RATELE)#2)&(RARPTSTS="R"):1,1:"") "RTN","RAHLO1",85,0) ; "RTN","RAHLO1",86,0) ;build the RADFA array to file Dx Code, resident/staff, and the report pointer "RTN","RAHLO1",87,0) ;with a single call to FILE^DIE (silent DBS call) "RTN","RAHLO1",88,0) K RAFDA,RAIENS S RAIENS=RACNI_","_RADTI_","_RADFN_"," "RTN","RAHLO1",89,0) ; "RTN","RAHLO1",90,0) ; 02/08/2008 GJC replaced $G w/($D(RADX)#2) p84 "RTN","RAHLO1",91,0) ; 11/15/2007 BAY/KAM RA*5*87 Rem Call 216332 Changed next line to $G "RTN","RAHLO1",92,0) ; 09/07/2005 108405 KAM/BAY Removed('$D(RADENDUM)#2) from next line "RTN","RAHLO1",93,0) I ($D(RADX)#2),RARELTEL="" D "RTN","RAHLO1",94,0) .S RAFDA(70.03,RAIENS,13)=RADX "RTN","RAHLO1",95,0) .S:$P(^RA(78.3,+RADX,0),U,4)="y" RAAB=1 "RTN","RAHLO1",96,0) .Q "RTN","RAHLO1",97,0) ; "RTN","RAHLO1",98,0) K RARELTEL "RTN","RAHLO1",99,0) S RAZRES=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")) "RTN","RAHLO1",100,0) S RAZSTF=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF")) "RTN","RAHLO1",101,0) ; "RTN","RAHLO1",102,0) I '($D(RADENDUM)#2),(RAZRES!(RAZSTF)) D "RTN","RAHLO1",103,0) .S:$D(^VA(200,"ARC","R",RAZRES)) RAFDA(70.03,RAIENS,12)=RAZRES "RTN","RAHLO1",104,0) .S:$D(^VA(200,"ARC","S",RAZSTF)) RAFDA(70.03,RAIENS,15)=RAZSTF "RTN","RAHLO1",105,0) .Q "RTN","RAHLO1",106,0) ; "RTN","RAHLO1",107,0) S RAZ7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;the following business rule needs review "RTN","RAHLO1",108,0) S RAZPCE=$S($D(^VA(200,"ARC","S",+$G(RAVERF))):15,$D(^VA(200,"ARC","R",+$G(RAVERF))):12,1:"") "RTN","RAHLO1",109,0) I '($D(RADENDUM)#2),(RAZPCE),($P(RAZ7003,U,RAZPCE)="") S RAFDA(70.03,RAIENS,RAZPCE)=$G(RAVERF) "RTN","RAHLO1",110,0) ; "RTN","RAHLO1",111,0) ;file the report pointer w/the exam record "RTN","RAHLO1",112,0) S RAFDA(70.03,RAIENS,17)=RARPT "RTN","RAHLO1",113,0) D FILE^DIE(,"RAFDA","RAERR") "RTN","RAHLO1",114,0) I $D(RAERR("DIERR"))#2 D L -^RARPT(RARPT) Q ;if error, unlock f74 and quit. "RTN","RAHLO1",115,0) .N RAFIELD S RAFIELD=$G(RAERR("DIERR",1,"PARAM","FIELD")) "RTN","RAHLO1",116,0) .S RAERR="Error: IENs = "_RAIENS_"; file:70.03; field: "_RAFIELD_" value: "_$S(RAFIELD=13:RADX,RAFIELD=12:RAZRES,RAFIELD=15:RAZSTF,1:RARPT) "RTN","RAHLO1",117,0) K RAFDA,RAIENS,RAZ7003,RAZPCE,RAZRES,RAZSTF "RTN","RAHLO1",118,0) ;---- end FILE^DIE block for 70.03 ---- "RTN","RAHLO1",119,0) ; "RTN","RAHLO1",120,0) ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx "RTN","RAHLO1",121,0) I $D(RASECDX) D "RTN","RAHLO1",122,0) . N RAX S RAX=0 "RTN","RAHLO1",123,0) . F S RAX=$O(RASECDX(RAX)) Q:RAX'>0 D "RTN","RAHLO1",124,0) .. S:$P(^RA(78.3,+RAX,0),U,4)="y" RAAB=1 "RTN","RAHLO1",125,0) ; "RTN","RAHLO1",126,0) ; file impression text if present & not an addendum "RTN","RAHLO1",127,0) I '$D(RADENDUM) D "RTN","RAHLO1",128,0) . S J=0 I $O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",0)) S I=0 F J=0:1 S I=$O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",I)) Q:I'>0 I $D(^(I)) S ^RARPT(RARPT,"I",(J+1),0)=$G(^TMP("RARPT-REC",$J,RASUB,"RAIMP",I)) "RTN","RAHLO1",129,0) . S:J ^RARPT(RARPT,"I",0)="^^"_J_U_J_U_RADATE "RTN","RAHLO1",130,0) . Q "RTN","RAHLO1",131,0) ; file report text if present & not an addendum "RTN","RAHLO1",132,0) I '$D(RADENDUM) D "RTN","RAHLO1",133,0) . S J=0 I $O(^TMP("RARPT-REC",$J,RASUB,"RATXT",0)) S I=0 F J=0:1 S I=$O(^TMP("RARPT-REC",$J,RASUB,"RATXT",I)) Q:I'>0 I $D(^(I)) S ^RARPT(RARPT,"R",(J+1),0)=$G(^TMP("RARPT-REC",$J,RASUB,"RATXT",I)) "RTN","RAHLO1",134,0) . S:J ^RARPT(RARPT,"R",0)="^^"_J_U_J_U_RADATE "RTN","RAHLO1",135,0) . Q "RTN","RAHLO1",136,0) ; if addendum, add addendum text to impression or report "RTN","RAHLO1",137,0) I $D(RADENDUM),($O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",0))!$O(^TMP("RARPT-REC",$J,RASUB,"RATXT",0))) D ADENDUM^RAHLO2 ; store new lines at the end of existing text "RTN","RAHLO1",138,0) ; "RTN","RAHLO1",139,0) ; Check for History from Dictation "RTN","RAHLO1",140,0) ; If history sent, check if previous history exists. If previous "RTN","RAHLO1",141,0) ; history then current history will follow adding 'Addendum:' before "RTN","RAHLO1",142,0) ; the text. "RTN","RAHLO1",143,0) I $O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0)) D "RTN","RAHLO1",144,0) . S RACNT=+$O(^RARPT(RARPT,"H",9999999),-1),RAHSTNDE=RACNT+1 "RTN","RAHLO1",145,0) . S RANEW=$S(RACNT>0:0,1:1) "RTN","RAHLO1",146,0) . S I=0 F S I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) Q:I'>0 D "RTN","RAHLO1",147,0) . . S RACNT=RACNT+1 "RTN","RAHLO1",148,0) . . S RALN=$G(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) "RTN","RAHLO1",149,0) . . S:'RANEW&(I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0))) RALN="Addendum: "_RALN ; if the first line, append 'Addendum:' "RTN","RAHLO1",150,0) . . I (RAHSTNDE=RACNT),(RACNT>1) S ^RARPT(RARPT,"H",RACNT,0)=" ",RACNT=RACNT+1 "RTN","RAHLO1",151,0) . . S ^RARPT(RARPT,"H",RACNT,0)=RALN "RTN","RAHLO1",152,0) . . Q "RTN","RAHLO1",153,0) . S ^RARPT(RARPT,"H",0)="^^"_RACNT_U_RACNT_U_RADATE "RTN","RAHLO1",154,0) . Q "RTN","RAHLO1",155,0) ; "RTN","RAHLO1",156,0) I $P(^RARPT(RARPT,0),U,5)="V",$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ; women's health "RTN","RAHLO1",157,0) G:'RAPRTSET UPACT ; the next section is for printsets only "RTN","RAHLO1",158,0) ; copy DX (prim & sec), Prim Resid, Prim Staff "RTN","RAHLO1",159,0) N RACNISAV,RA7 "RTN","RAHLO1",160,0) N RA13,RA12,RA15 ;prim dx, prim resid, prim staff, rpt pointer "RTN","RAHLO1",161,0) S RACNISAV=RACNI,RA7=0 "RTN","RAHLO1",162,0) S RA13=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13),RA12=$P(^(0),U,12),RA15=$P(^(0),U,15) "RTN","RAHLO1",163,0) F S RA7=$O(RAMEMARR(RA7)) Q:RA7="" I RACNISAV'=RA7 S RACNI=RA7 D UPMEM^RAHLO4 I $D(RASECDX),('$D(RADENDUM)#2) D SECDX^RAHLO2 "RTN","RAHLO1",164,0) S RACNI=RACNISAV "RTN","RAHLO1",165,0) ; "RTN","RAHLO1",166,0) UPACT ;Update the Activity Log (74.01) w/DBS call "RTN","RAHLO1",167,0) K RAIENS,RAFDA S RAIENS="+1,"_RARPT_"," "RTN","RAHLO1",168,0) S RAFDA(74.01,RAIENS,.01)=$E($$NOW^XLFDT(),1,12) "RTN","RAHLO1",169,0) S RAFDA(74.01,RAIENS,2)=$S(RARPTSTS="V":"V",$D(RAEDIT):"E",1:"I") "RTN","RAHLO1",170,0) S RAFDA(74.01,RAIENS,3)=$S($G(RAVERF):RAVERF,$G(RATRANSC):RATRANSC,1:"") "RTN","RAHLO1",171,0) D UPDATE^DIE("","RAFDA","RAIENS","") K RAIENS,RAFDA,DIERR,^TMP("DIERR",$J) "RTN","RAHLO1",172,0) ; "RTN","RAHLO1",173,0) ; 12/15/2009 BAY/KAM RA*5*104 Changed next line to rebuild indexes "RTN","RAHLO1",174,0) ;S RAQUEUED=1 ;to be checked in routines "jumped to" from RAHLO1 "RTN","RAHLO1",175,0) S DA=RARPT,DIK="^RARPT(",RAQUEUED=1 D IX^DIK K DA,DIK "RTN","RAHLO1",176,0) ; "RTN","RAHLO1",177,0) L -^RARPT(RARPT) ;unlock the report locked at FILE (existing rpt) or NEW1 (new rpt) "RTN","RAHLO1",178,0) ; "RTN","RAHLO1",179,0) ;If verified, update report & exam statuses; else, just update exam status "RTN","RAHLO1",180,0) ;Note: be careful; exam locks are executed within UP1^RAUTL1! "RTN","RAHLO1",181,0) I $D(RAMDV),RAMDV'="" D:RARPTSTS="V" UPSTAT^RAUTL0 D:RARPTSTS'="V" UP1^RAUTL1 "RTN","RAHLO1",182,0) D:'$D(RAERR)&($G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL") GENACK^RAHLTCPB ; generate 'ACK' message "RTN","RAHLO1",183,0) ; "RTN","RAHLO1",184,0) PACS ;If there are subscribers to RA RPT xxx events broadcast ORU mesages to those subscribers "RTN","RAHLO1",185,0) ;via TASK^RAHLO4. If VOICE DICTATION AUTO-PRINT (#26) field is set to 'Y' print the report to "RTN","RAHLO1",186,0) ;the printer defined in the REPORT PRINTER NAME (#10) field via VOICE^RAHLO4. "RTN","RAHLO1",187,0) I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D TASK^RAHLO4,VOICE^RAHLO4 "RTN","RAHLO1",188,0) ; "RTN","RAHLO1",189,0) KVAR K RAAB,RAEDIT,RAESIG,RAQUEUED,RAHIST "RTN","RAHLO1",190,0) Q "RTN","RAHLO1",191,0) ; "VER") 8.0^22.0 "BLD",7577,6) ^91 **END** **END**