Released RA*5*66 SEQ #55 Extracted from mail message **KIDS**:RA*5.0*66^ **INSTALL NAME** RA*5.0*66 "BLD",5788,0) RA*5.0*66^RADIOLOGY/NUCLEAR MEDICINE^0^3051003^y "BLD",5788,1,0) ^^1^1^3050906^ "BLD",5788,1,1,0) ALLOW RADIOLOGY TO ACCEPT DIAGNOSIS CODE CHANGES FROM TALK TECHNOLOGY "BLD",5788,4,0) ^9.64PA^^ "BLD",5788,"KRN",0) ^9.67PA^8989.52^19 "BLD",5788,"KRN",.4,0) .4 "BLD",5788,"KRN",.401,0) .401 "BLD",5788,"KRN",.402,0) .402 "BLD",5788,"KRN",.403,0) .403 "BLD",5788,"KRN",.5,0) .5 "BLD",5788,"KRN",.84,0) .84 "BLD",5788,"KRN",3.6,0) 3.6 "BLD",5788,"KRN",3.8,0) 3.8 "BLD",5788,"KRN",9.2,0) 9.2 "BLD",5788,"KRN",9.8,0) 9.8 "BLD",5788,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",5788,"KRN",9.8,"NM",1,0) RAHLO^^0^B39097483 "BLD",5788,"KRN",9.8,"NM",2,0) RAHLO1^^0^B45858218 "BLD",5788,"KRN",9.8,"NM","B","RAHLO",1) "BLD",5788,"KRN",9.8,"NM","B","RAHLO1",2) "BLD",5788,"KRN",19,0) 19 "BLD",5788,"KRN",19.1,0) 19.1 "BLD",5788,"KRN",101,0) 101 "BLD",5788,"KRN",409.61,0) 409.61 "BLD",5788,"KRN",771,0) 771 "BLD",5788,"KRN",870,0) 870 "BLD",5788,"KRN",8989.51,0) 8989.51 "BLD",5788,"KRN",8989.52,0) 8989.52 "BLD",5788,"KRN",8994,0) 8994 "BLD",5788,"KRN","B",.4,.4) "BLD",5788,"KRN","B",.401,.401) "BLD",5788,"KRN","B",.402,.402) "BLD",5788,"KRN","B",.403,.403) "BLD",5788,"KRN","B",.5,.5) "BLD",5788,"KRN","B",.84,.84) "BLD",5788,"KRN","B",3.6,3.6) "BLD",5788,"KRN","B",3.8,3.8) "BLD",5788,"KRN","B",9.2,9.2) "BLD",5788,"KRN","B",9.8,9.8) "BLD",5788,"KRN","B",19,19) "BLD",5788,"KRN","B",19.1,19.1) "BLD",5788,"KRN","B",101,101) "BLD",5788,"KRN","B",409.61,409.61) "BLD",5788,"KRN","B",771,771) "BLD",5788,"KRN","B",870,870) "BLD",5788,"KRN","B",8989.51,8989.51) "BLD",5788,"KRN","B",8989.52,8989.52) "BLD",5788,"KRN","B",8994,8994) "BLD",5788,"QUES",0) ^9.62^^ "BLD",5788,"REQB",0) ^9.611^1^1 "BLD",5788,"REQB",1,0) RA*5.0*55^1 "BLD",5788,"REQB","B","RA*5.0*55",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^3011017^2980407^50 "PKG",18,22,1,"PAH",1,0) 66^3051003 "PKG",18,22,1,"PAH",1,1,0) ^^1^1^3051003 "PKG",18,22,1,"PAH",1,1,1,0) ALLOW RADIOLOGY TO ACCEPT DIAGNOSIS CODE CHANGES FROM TALK TECHNOLOGY "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") YES "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") YES "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") 2 "RTN","RAHLO") 0^1^B39097483 "RTN","RAHLO",1,0) RAHLO ;HIRMFO/GJC-Process data set from the bridge program ;11/18/97 12:13 "RTN","RAHLO",2,0) ;;5.0;Radiology/Nuclear Medicine;**4,8,27,55,66**;Mar 16, 1998 "RTN","RAHLO",3,0) ; 09/07/2005 Remedy call 108405 - KAM Allow Radiology to accept dx codes from Talk Technology "RTN","RAHLO",4,0) EN1 ; Check the validity of the following data globals: "RTN","RAHLO",5,0) ; Example: '^TMP("RARPT-REC",$J,RASUB,' where RASUB is a "RTN","RAHLO",6,0) ; record in file 772. "RTN","RAHLO",7,0) ;**************** Validates (if data present): ************************ "RTN","RAHLO",8,0) ; ^TMP("RARPT-REC",$J,RASUB,"RACNI")=case ien "RTN","RAHLO",9,0) ; ^TMP("RARPT-REC",$J,RASUB,"RADATE")=date reported/entered/verified "RTN","RAHLO",10,0) ; ^TMP("RARPT-REC",$J,RASUB,"RADFN")=patient ien "RTN","RAHLO",11,0) ; ^TMP("RARPT-REC",$J,RASUB,"RADTI")=inverted exam date/time "RTN","RAHLO",12,0) ; ^TMP("RARPT-REC",$J,RASUB,"RADX",#)=Dx codes (could be more than 1) "RTN","RAHLO",13,0) ; ^TMP("RARPT-REC",$J,RASUB,"RAESIG")=Verifier's E-Sig (if present) "RTN","RAHLO",14,0) ; ^TMP("RARPT-REC",$J,RASUB,"RAHIST")=Additional Clinical History "RTN","RAHLO",15,0) ; ^TMP("RARPT-REC",$J,RASUB,"RAIMP",#)=Impression Text "RTN","RAHLO",16,0) ; ^TMP("RARPT-REC",$J,RASUB,"RALONGCN")=Long Case Number "RTN","RAHLO",17,0) ; ^TMP("RARPT-REC",$J,RASUB,"RASSN")=Patient SSN "RTN","RAHLO",18,0) ; ^TMP("RARPT-REC",$J,RASUB,"RASTAT")=A, F or R (amend, final or prelim) "RTN","RAHLO",19,0) ; ^TMP("RARPT-REC",$J,RASUB,"RATXT",#)=Report Text "RTN","RAHLO",20,0) ; ^TMP("RARPT-REC",$J,RASUB,"VENDOR")=vendor "RTN","RAHLO",21,0) ; ^TMP("RARPT-REC",$J,RASUB,"RAVERF")=Verifier ien "RTN","RAHLO",22,0) ; ^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")=transcriptionist (optional) "RTN","RAHLO",23,0) ; ^TMP("RARPT-REC",$J,RASUB,"RASTAFF")=Primary staff "RTN","RAHLO",24,0) ; ^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")=Primary resident "RTN","RAHLO",25,0) ; ^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")=Who changed status to Verify "RTN","RAHLO",26,0) ;********************************************************************** "RTN","RAHLO",27,0) K RAERR S RAQUIET=1 "RTN","RAHLO",28,0) ; Check if the minimum data set exists. "RTN","RAHLO",29,0) I '$D(^TMP("RARPT-REC",$J,RASUB,"RACNI")) S RAERR="Missing Case Number" Q "RTN","RAHLO",30,0) I '$D(^TMP("RARPT-REC",$J,RASUB,"RADFN")) S RAERR="Internal Patient ID Missing" Q "RTN","RAHLO",31,0) I '$D(^TMP("RARPT-REC",$J,RASUB,"RADTI")) S RAERR="Missing Exam Date" Q "RTN","RAHLO",32,0) I '$D(^TMP("RARPT-REC",$J,RASUB,"RALONGCN")) S RAERR="Missing Exam Date and/or Case Number" Q "RTN","RAHLO",33,0) I '$D(^TMP("RARPT-REC",$J,RASUB,"RASSN")) S RAERR="Missing Patient ID" Q "RTN","RAHLO",34,0) D CHECK ; check the validity of our data. "RTN","RAHLO",35,0) XIT ; Kill and quit "RTN","RAHLO",36,0) K A,B,DFN,K,RACNI,RADX,RADENDUM,RADFN,RADTI,RADUZ,RAIMGTY,RALONGCN,RAMDIV,RAMDV,RAMLC,RAQUIET,RADPIECE,RARPT,RARPTSTS,RASSN,RAVLDT,X,Y,RATRANSC "RTN","RAHLO",37,0) Q "RTN","RAHLO",38,0) CHECK ; Check if our data is valid. "RTN","RAHLO",39,0) S RACNI=$G(^TMP("RARPT-REC",$J,RASUB,"RACNI")) "RTN","RAHLO",40,0) S RADATE=$G(^TMP("RARPT-REC",$J,RASUB,"RADATE")) "RTN","RAHLO",41,0) S RADFN=$G(^TMP("RARPT-REC",$J,RASUB,"RADFN")) "RTN","RAHLO",42,0) S RADTI=$G(^TMP("RARPT-REC",$J,RASUB,"RADTI")) "RTN","RAHLO",43,0) S RALONGCN=$G(^TMP("RARPT-REC",$J,RASUB,"RALONGCN")) "RTN","RAHLO",44,0) S RASSN=$G(^TMP("RARPT-REC",$J,RASUB,"RASSN")) "RTN","RAHLO",45,0) S (RAVERF,RADUZ)=$G(^TMP("RARPT-REC",$J,RASUB,"RAVERF")) "RTN","RAHLO",46,0) S RATRANSC=$G(^TMP("RARPT-REC",$J,RASUB,"RATRANSCRIPT")) "RTN","RAHLO",47,0) S RASTAT=$G(^TMP("RARPT-REC",$J,RASUB,"RASTAT")) I RASTAT="A" S RADENDUM="" "RTN","RAHLO",48,0) I $D(^TMP("RARPT-REC",$J,RASUB,"RAESIG")) S RAESIG=$G(^("RAESIG")) "RTN","RAHLO",49,0) I $D(^TMP("RARPT-REC",$J,RASUB,"RAIMP")) D IMPTXT^RAHLO2 "RTN","RAHLO",50,0) I RADATE']"" S RAERR="Missing report date" Q "RTN","RAHLO",51,0) I RADFN']"" S RAERR="Missing Internal Patient ID" Q "RTN","RAHLO",52,0) I RACNI']"" S RAERR="Missing Case Number" Q "RTN","RAHLO",53,0) I RADTI']"" S RAERR="Missing Exam Date" Q "RTN","RAHLO",54,0) D DT^DILF("ET",RADATE,.RAVLDT) "RTN","RAHLO",55,0) S:RAVLDT=-1 RAERR="Invalid report date" Q:$D(RAERR) "RTN","RAHLO",56,0) K VA,VADM,VAERR S DFN=RADFN D DEM^VADPT I VADM(1)']""!(RASSN'=$P(VADM(2),"^")) S RAERR="Internal patient identifier and SSN don't match" K VA,VADM,VAERR Q "RTN","RAHLO",57,0) I '$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))!(RALONGCN']"") D Q "RTN","RAHLO",58,0) . S RAERR="Invalid Exam Date and/or Case Number" "RTN","RAHLO",59,0) . Q "RTN","RAHLO",60,0) D EDTCHK^RAHLQ ; is user allowed to edit report for a cancelled case? "RTN","RAHLO",61,0) I RARPT=1 S RAERR="Report for CANCELLED case not permitted." Q "RTN","RAHLO",62,0) I RARPT=2 S RAERR="Please use VISTA to edit CANCELLED printset cases." Q "RTN","RAHLO",63,0) S RARPT=+$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17) "RTN","RAHLO",64,0) I '$D(^RARPT(RARPT,0)),($D(RADENDUM)#2) S RAERR="Can't add addendum, no report" Q "RTN","RAHLO",65,0) I $D(^RARPT(RARPT,0)),($P(^(0),"^",5)'="V"),($D(RADENDUM)#2) S RAERR="Can't add addendum to an unverified report" Q "RTN","RAHLO",66,0) I $D(^RARPT(RARPT,0)),$P(^(0),"^",5)="V",('$D(RADENDUM)#2) S RAERR="Report already on file" Q "RTN","RAHLO",67,0) I ($D(RADENDUM)#2),'$O(^TMP("RARPT-REC",$J,RASUB,"RAIMP",0)),'$O(^TMP("RARPT-REC",$J,RASUB,"RATXT",0)) S RAERR="Missing addendum report/impression text" Q "RTN","RAHLO",68,0) I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAMDIV=^(0),RAMLC=+$P(RAMDIV,"^",4),RAMDIV=+$P(RAMDIV,"^",3),RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:""),RAMDV=$S(RAMDV="":RAMDV,1:$TR(RAMDV,"YyNn",1100)) "RTN","RAHLO",69,0) I '($D(RADENDUM)#2) I $P(RAMDV,"^",16),('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) S RAERR="Missing Impression Text" Q ; impression req'd for this division "RTN","RAHLO",70,0) I ($D(RADENDUM)#2),($D(^RARPT(RARPT,0))#2),($P(RAMDV,"^",16)),('$O(^RARPT(RARPT,"I",0))),('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) S RAERR="Impression Text missing for current record." Q ; impression req'd for this division "RTN","RAHLO",71,0) I $D(RADENDUM)#2 D CKDUPA^RAHLO4 I RADUPA S RAERR="Duplicate Addendum" Q "RTN","RAHLO",72,0) ; check resident and staff "RTN","RAHLO",73,0) N X1,X2,X3 S X2=0,X3="" "RTN","RAHLO",74,0) I +$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT"))!(+$G(^("RASTAFF"))) D Q:$G(RAERR)]"" "RTN","RAHLO",75,0) . S X1=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")) "RTN","RAHLO",76,0) . I X1 D "RTN","RAHLO",77,0) .. I '$D(^VA(200,"ARC","R",X1)) S X2=1 "RTN","RAHLO",78,0) .. I $P($G(^VA(200,X1,"RA")),"^",3),$P(^("RA"),"^",3)'>$$DT^XLFDT S X2=X2+2 "RTN","RAHLO",79,0) .. I X2=1 S X3=$E($P($G(^VA(200,X1,0)),"^"),1,20)_" is not class'd as resident" "RTN","RAHLO",80,0) .. I X2=2 S X3=$P($G(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past" "RTN","RAHLO",81,0) .. I X2=3 S X3=$P($G(^VA(200,X1,0)),"^")_" is not class'd as resident and past INACTIVE DATE" "RTN","RAHLO",82,0) .. I X3]"" S RAERR=X3 "RTN","RAHLO",83,0) . S X2=0,X3="" S X1=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF")) "RTN","RAHLO",84,0) . I X1 D "RTN","RAHLO",85,0) .. I '$D(^VA(200,"ARC","S",X1)) S X2=1 "RTN","RAHLO",86,0) .. I $P($G(^VA(200,X1,"RA")),"^",3),$P(^("RA"),"^",3)'>$$DT^XLFDT S X2=X2+2 "RTN","RAHLO",87,0) .. I X2=1 S X3=$E($P($G(^VA(200,X1,0)),"^"),1,20)_" is not class'd as staff" "RTN","RAHLO",88,0) .. I X2=2 S X3=$P($G(^VA(200,X1,0)),"^")_"'s INACTIVE DATE is past" "RTN","RAHLO",89,0) .. I X2=3 S X3=$P($G(^VA(200,X1,0)),"^")_" is not class'd as staff and past INACTIVE DATE" "RTN","RAHLO",90,0) .. I X3]"" S RAERR=$S($G(RAERR)]"":RAERR_", ",1:"")_X3 "RTN","RAHLO",91,0) . Q "RTN","RAHLO",92,0) ; raesig is in alphanumeric format, so shouldn't use $g of it here "RTN","RAHLO",93,0) I ($G(RAESIG)]"")!($G(RAVERF)) D VERCHK^RAHLO3 ; check if provider can verify report "RTN","RAHLO",94,0) ; if verifier fails checks, "RTN","RAHLO",95,0) ; quit only if vendor is non-kurzweil, "RTN","RAHLO",96,0) ; if vendor is kurzweil, continue on by deleting raerr, raverf "RTN","RAHLO",97,0) I $D(RAERR) Q:$G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL" K RAERR,RAVERF "RTN","RAHLO",98,0) S RAIMGTY=$$IMGTY^RAUTL12("l",RAMLC) I '$L(RAIMGTY) S RAERR="No Imaging Type for Location where exam was performed" Q "RTN","RAHLO",99,0) K RASECDX ;clear secondary dx array because RAHLO2 may not be called "RTN","RAHLO",100,0) ; 09/07/2005 108405 KAM- Removed ('$D(RADENDUM)#2) from next line "RTN","RAHLO",101,0) D:$D(^TMP("RARPT-REC",$J,RASUB,"RADX")) DIAG^RAHLO2 Q:$D(RAERR) ; DX code check took out - &('$D(RADENDUM)#2) "RTN","RAHLO",102,0) ; edit sec Dx codes if they exist for non-addendums "RTN","RAHLO",103,0) ; 09/07/2005 108405 KAM - Removed ('$D(RADENDUM)#2)from next line "RTN","RAHLO",104,0) I $D(RASECDX) D SECDX^RAHLO2 Q:$D(RAERR) "RTN","RAHLO",105,0) S B=0 F A="I","R" D Q:$D(RAERR) "RTN","RAHLO",106,0) . Q:A="R"&('$D(^TMP("RARPT-REC",$J,RASUB,"RATXT"))) ; no rpt text "RTN","RAHLO",107,0) . Q:A="I"&('$D(^TMP("RARPT-REC",$J,RASUB,"RAIMP"))) ; no imp text "RTN","RAHLO",108,0) . S B=$$TEXT^RAHLO3(A) "RTN","RAHLO",109,0) . S:'B RAERR=$$ERR^RAHLO2(A) "RTN","RAHLO",110,0) . Q "RTN","RAHLO",111,0) D RPTSTAT^RAHLO3 ; determine the status of the report "RTN","RAHLO",112,0) D FILE^RAHLO1:'$D(RAERR) "RTN","RAHLO",113,0) Q "RTN","RAHLO1") 0^2^B45858218 "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**;Mar 16, 1998 "RTN","RAHLO1",3,0) ; 09/07/2005 108405 - KAM/BAY Allow Radiology to accept dx codes from Talk Technology "RTN","RAHLO1",4,0) ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx "RTN","RAHLO1",5,0) ; This routine uses the following IA: "RTN","RAHLO1",6,0) ; #4793 - ^WVRALINK (private) "RTN","RAHLO1",7,0) FILE ;Create Entry in File 74 and File Data "RTN","RAHLO1",8,0) I '$D(ZTQUEUED) N ZTQUEUED S ZTQUEUED="1^dummy to suppress screen displays in UP2^RAUTL1 and elsewhere" "RTN","RAHLO1",9,0) I '$D(RAQUIET) N RAQUIET S RAQUIET="1^dummy to suppress screen display in PTR^RARTE2" "RTN","RAHLO1",10,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",11,0) S RADPIECE=$S($D(^VA(200,"ARC","S",+$G(RAVERF))):15,$D(^VA(200,"ARC","R",+$G(RAVERF))):12,1:"") "RTN","RAHLO1",12,0) N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR "RTN","RAHLO1",13,0) D EN2^RAUTL20(.RAMEMARR) ; 04/30/99 always recalculate RAPRTSET "RTN","RAHLO1",14,0) ; If rpt (either stub or real) exists, skip creating a new file 74 entry "RTN","RAHLO1",15,0) I RARPT,$D(^RARPT(RARPT,0)) S RASAV=RARPT D FILETST^RAHLO4 Q:$D(RAERR) D S RARPT=RASAV K RASAV G LOCK1 "RTN","RAHLO1",16,0) . ; must save off RARPT, RAVERF and other RA* variables because "RTN","RAHLO1",17,0) . ; they are being killed off somewhere in the 'Unverify A Report' "RTN","RAHLO1",18,0) . ; option. "RTN","RAHLO1",19,0) . N RADFN,RADTI,RACNI,RARPTSTS,RASSN,RADATE,RALONGCN,RAVERF "RTN","RAHLO1",20,0) . ; if report isn't a stub report, then consider it being edited "RTN","RAHLO1",21,0) . S:'$$STUB^RAEDCN1(RARPT) RAEDIT=1 "RTN","RAHLO1",22,0) . I $D(RADENDUM)#2,($P(^RARPT(RARPT,0),"^",5)="V") D Q ; edit on current record (for activity log) "RTN","RAHLO1",23,0) .. D UNVER^RARTE1(RARPT) "RTN","RAHLO1",24,0) .. Q "RTN","RAHLO1",25,0) . K ^RARPT(RARPT,"I"),^("R"),^("H") "RTN","RAHLO1",26,0) . Q "RTN","RAHLO1",27,0) I RAPRTSET L +^RADPT(RADFN,"DT",RADTI):0 G:$T NEW1 S RAERR="ANOTHER USER IS CURRENTLY EDITING THIS PRINTSET. TRY LATER." D KVAR Q "RTN","RAHLO1",28,0) NEW1 S I=$P(^RARPT(0),"^",3) "RTN","RAHLO1",29,0) LOCK S I=I+1 L +^RARPT(I):1 I '$T!($D(^RARPT(I)))!($D(^RARPT("B",I))) L -^RARPT(I) G LOCK "RTN","RAHLO1",30,0) S ^RARPT(I,0)=RALONGCN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1) "RTN","RAHLO1",31,0) ;if case is member of a print set, then create sub-recs for file #74 "RTN","RAHLO1",32,0) G:'RAPRTSET LOCK1 "RTN","RAHLO1",33,0) I '$D(RARPTN) N RARPTN S RARPTN=RALONGCN "RTN","RAHLO1",34,0) N RAXIT D PTR^RARTE2 ;create corresponding subrecs in ^RARPT() "RTN","RAHLO1",35,0) I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI) D KVAR Q ;unlck & clear vars "RTN","RAHLO1",36,0) LOCK1 I $D(RAESIG) S X=RAESIG,X1=$G(RAVERF),X2=RARPT D EN^XUSHSHP S RAESIG=X "RTN","RAHLO1",37,0) K DA,DIE,DQ,DR S DA=RARPT,DIE="^RARPT(" "RTN","RAHLO1",38,0) S DR="5////"_RARPTSTS ; rpt status "RTN","RAHLO1",39,0) ;Verifier & Verified date will be set if RAVERF exists for new "RTN","RAHLO1",40,0) ;reports, edits, and addendums. Date rpt entered and reported date "RTN","RAHLO1",41,0) ;will be set for new reports, and not reset for edits and addendums "RTN","RAHLO1",42,0) S DR=DR_";6////"_$S($D(RAEDIT):"",1:RADATIME) ; date/time rpt entered "RTN","RAHLO1",43,0) S DR=DR_";7////"_$S($G(RAVERF)&(RARPTSTS="V"):RADATIME,1:"") ; v'fied date/time "RTN","RAHLO1",44,0) S DR=DR_";8////"_$S($D(RAEDIT):"",1:RADATE) ; reported date "RTN","RAHLO1",45,0) S DR=DR_";9////"_$S($G(RAVERF)&(RARPTSTS="V"):RAVERF,1:"") ; v'fying phys "RTN","RAHLO1",46,0) S DR=DR_";11////"_$S($G(RATRANSC):RATRANSC,$G(RAVERF):RAVERF,1:"") ; transcriptionist "RTN","RAHLO1",47,0) I $G(RAVERF),(RARPTSTS="V") S DR=DR_";17////"_$G(^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")) ;status changed to 'verified' by "RTN","RAHLO1",48,0) ; D ^DIE K DA,DR ;BNT- Moved the DIE call down three lines due to a "RTN","RAHLO1",49,0) ; problem found at Indy while testing PowerScribe. Site was doing a "RTN","RAHLO1",50,0) ; local MUMPS cross reference on one of the nodes that are set below. "RTN","RAHLO1",51,0) S $P(^RARPT(RARPT,0),"^",2)=RADFN,$P(^(0),"^",3)=(9999999.9999-RADTI),$P(^(0),"^",4)=$P(RALONGCN,"-",2) ;must set manually due uneditable "RTN","RAHLO1",52,0) S $P(^RARPT(RARPT,0),"^",10)=$S($D(RAESIG)&(RARPTSTS="V"):RAESIG,1:"") ; hard set because Elec Sig Code may contain a semi-colon which causes errors in DIE "RTN","RAHLO1",53,0) D ^DIE K DA,DR "RTN","RAHLO1",54,0) ; 09/07/2005 108405 KAM/BAY Removed('$D(RADENDUM)#2) from next line "RTN","RAHLO1",55,0) I $D(RADX) D "RTN","RAHLO1",56,0) . K DIE,DA,DR S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN "RTN","RAHLO1",57,0) . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," "RTN","RAHLO1",58,0) . S DR="13////"_RADX D ^DIE K DIE,DA,DR "RTN","RAHLO1",59,0) . S:$P(^RA(78.3,+RADX,0),"^",4)="y" RAAB=1 "RTN","RAHLO1",60,0) . Q "RTN","RAHLO1",61,0) ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx "RTN","RAHLO1",62,0) I $D(RASECDX) D "RTN","RAHLO1",63,0) . N RAX S RAX=0 "RTN","RAHLO1",64,0) . F S RAX=$O(RASECDX(RAX)) Q:RAX'>0 D "RTN","RAHLO1",65,0) .. S:$P(^RA(78.3,+RAX,0),"^",4)="y" RAAB=1 "RTN","RAHLO1",66,0) ; "RTN","RAHLO1",67,0) I '$D(RADENDUM)#2,($G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF"))!$G(^("RARESIDENT"))) D "RTN","RAHLO1",68,0) . K DIE,DA S DR="" "RTN","RAHLO1",69,0) . S RAPRIMAR=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")) I $D(^VA(200,"ARC","R",RAPRIMAR)) S DR="12////"_RAPRIMAR "RTN","RAHLO1",70,0) . S RAPRIMAR=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF")) I $D(^VA(200,"ARC","S",RAPRIMAR)) S DR=$S(DR]"":DR_";",1:"")_"15////"_RAPRIMAR "RTN","RAHLO1",71,0) . Q:'$G(DR) "RTN","RAHLO1",72,0) . S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN "RTN","RAHLO1",73,0) . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," "RTN","RAHLO1",74,0) . D ^DIE K DIE,DA,DR "RTN","RAHLO1",75,0) . Q "RTN","RAHLO1",76,0) ; "RTN","RAHLO1",77,0) S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RARPT I $G(RADPIECE),$P(^(0),"^",RADPIECE)="",('$D(RADENDUM)#2) D SETPHYS^RAHLO4 "RTN","RAHLO1",78,0) ; file impression text if present & not an addendum "RTN","RAHLO1",79,0) I '$D(RADENDUM) D "RTN","RAHLO1",80,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",81,0) . S:J ^RARPT(RARPT,"I",0)="^^"_J_"^"_J_"^"_RADATE "RTN","RAHLO1",82,0) . Q "RTN","RAHLO1",83,0) ; file report text if present & not an addendum "RTN","RAHLO1",84,0) I '$D(RADENDUM) D "RTN","RAHLO1",85,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",86,0) . S:J ^RARPT(RARPT,"R",0)="^^"_J_"^"_J_"^"_RADATE "RTN","RAHLO1",87,0) . Q "RTN","RAHLO1",88,0) ; if addendum, add addendum text to impression or report "RTN","RAHLO1",89,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",90,0) ; "RTN","RAHLO1",91,0) ; "RTN","RAHLO1",92,0) ; Check for History from Dictation "RTN","RAHLO1",93,0) ; If history sent, check if previous history exists. If previous "RTN","RAHLO1",94,0) ; history then current history will follow adding 'Addendum:' before "RTN","RAHLO1",95,0) ; the text. "RTN","RAHLO1",96,0) I $O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0)) D "RTN","RAHLO1",97,0) . S RACNT=+$O(^RARPT(RARPT,"H",9999999),-1),RAHSTNDE=RACNT+1 "RTN","RAHLO1",98,0) . S RANEW=$S(RACNT>0:0,1:1) "RTN","RAHLO1",99,0) . S I=0 F S I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) Q:I'>0 D "RTN","RAHLO1",100,0) . . S RACNT=RACNT+1 "RTN","RAHLO1",101,0) . . S RALN=$G(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) "RTN","RAHLO1",102,0) . . S:'RANEW&(I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0))) RALN="Addendum: "_RALN ; if the first line, append 'Addendum:' "RTN","RAHLO1",103,0) . . I (RAHSTNDE=RACNT),(RACNT>1) S ^RARPT(RARPT,"H",RACNT,0)=" ",RACNT=RACNT+1 "RTN","RAHLO1",104,0) . . S ^RARPT(RARPT,"H",RACNT,0)=RALN "RTN","RAHLO1",105,0) . . Q "RTN","RAHLO1",106,0) . S ^RARPT(RARPT,"H",0)="^^"_RACNT_"^"_RACNT_"^"_RADATE "RTN","RAHLO1",107,0) . Q "RTN","RAHLO1",108,0) ; "RTN","RAHLO1",109,0) ; "RTN","RAHLO1",110,0) I $P(^RARPT(RARPT,0),U,5)="V",$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ; women's health "RTN","RAHLO1",111,0) G:'RAPRTSET UPACT ; the next section is for printsets only "RTN","RAHLO1",112,0) ; copy DX (prim & sec), Prim Resid, Prim Staff "RTN","RAHLO1",113,0) N RACNISAV,RA7 "RTN","RAHLO1",114,0) N RA13,RA12,RA15 ;prim dx, prim resid, prim staff, rpt pointer "RTN","RAHLO1",115,0) S RACNISAV=RACNI,RA7=0 "RTN","RAHLO1",116,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",117,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",118,0) S RACNI=RACNISAV "RTN","RAHLO1",119,0) L -^RADPT(RADFN,"DT",RADTI) ;unlock after pce 17 is set in all cases of this printset "RTN","RAHLO1",120,0) ;Update Activity Log "RTN","RAHLO1",121,0) UPACT S DA=RARPT,DIE="^RARPT(",DR="100///""NOW""",DR(2,74.01)="2////"_$S(RARPTSTS="V":"V",$D(RAEDIT):"E",1:"I")_";3////"_$S($G(RATRANSC):RATRANSC,$G(RAVERF):RAVERF,1:"") D ^DIE K DA,DR,DE,DQ,DIE "RTN","RAHLO1",122,0) ; use ix^dik to kill before setting xrefs "RTN","RAHLO1",123,0) S DA=RARPT,DIK="^RARPT(",RAQUEUED=1 D IX^DIK "RTN","RAHLO1",124,0) ; if verfd, update rpt & exam statuses; else, just update exam status "RTN","RAHLO1",125,0) I $D(RAMDV),RAMDV'="" D:RARPTSTS="V" UPSTAT^RAUTL0 D:RARPTSTS'="V" UP1^RAUTL1 "RTN","RAHLO1",126,0) L -^RARPT(RARPT) D:'$D(RAERR)&($G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL") GENACK^RAHLTCPB ; generate 'ACK' message "RTN","RAHLO1",127,0) ; line pacs is for 2 tasks: hl7 msg'g & voice verified rpt printout "RTN","RAHLO1",128,0) PACS I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D TASK^RAHLO4,VOICE^RAHLO4 "RTN","RAHLO1",129,0) KVAR K RAAB,RAEDIT,RAESIG,RAQUEUED,RARPT,RAHIST "RTN","RAHLO1",130,0) Q "VER") 8.0^22.0 "BLD",5788,6) ^SEQ #55 **END** **END**