- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO1.m
r613 r623 1 RAHLO1 ;HIRMFO/GJC/BNT-File rpt (data from bridge program) ;6/25/04 11:49 2 ;;5.0;Radiology/Nuclear Medicine;**4,5,12,17,21,27,48,55,66,87,84**;Mar 16, 1998;Build 13 3 ; 11/15/2007 BAY/KAM RA*5*87 Rem Call 216332 Correct UNDEF on null dx code 4 ; 09/07/2005 108405 - KAM/BAY Allow Radiology to accept dx codes from Talk Technology 5 ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx 6 ; 7 ;Integration Agreements 8 ;---------------------- 9 ;DIE(10018); ,FILE^DIE(2053); IX^DIK(10013); CREATE^WVRALINK(4793); $$NOW^XLFDT(10103) 10 ;EN^XUSHSHP(10045) 11 ; 12 FILE ;Create Entry in File 74 and File Data 13 I '$D(ZTQUEUED) N ZTQUEUED S ZTQUEUED="1^dummy to suppress screen displays in UP2^RAUTL1 and elsewhere" 14 I '$D(RAQUIET) N RAQUIET S RAQUIET="1^dummy to suppress screen display in PTR^RARTE2" 15 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 16 S RADPIECE=$S($D(^VA(200,"ARC","S",+$G(RAVERF))):15,$D(^VA(200,"ARC","R",+$G(RAVERF))):12,1:"") 17 N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR 18 D EN2^RAUTL20(.RAMEMARR) ; 04/30/99 always recalculate RAPRTSET 19 ; If the report (stub/real) exists, unverify the existing report... Else create a new report 20 I RARPT,$D(^RARPT(RARPT,0)) S RASAV=RARPT D S RARPT=RASAV K RASAV Q:$D(RAERR) G LOCK1 21 . ; must save off RARPT, RAVERF and other RA* variables because 22 . ; they are being killed off somewhere in the 'Unverify A Report' 23 . ; option. 'Unverify A Report' does lock the the report record in file 74! 24 . N RADFN,RADTI,RACNI,RARPTSTS,RASSN,RADATE,RALONGCN,RAVERF 25 . ; if report isn't a stub report, then consider it being edited 26 . S:'$$STUB^RAEDCN1(RARPT) RAEDIT=1 27 . I $D(RADENDUM)#2,($P(^RARPT(RARPT,0),"^",5)="V") D Q ; edit on current record (for activity log) 28 .. D UNVER^RARTE1(RARPT) 29 .. Q 30 . K ^RARPT(RARPT,"I"),^("R"),^("H") 31 . Q 32 ; New report logic @NEW1 33 NEW1 S I=$P(^RARPT(0),"^",3) 34 ;since this is a new report (not linked to an exam), directly lock the new record *1 lR* 35 LOCK S I=I+1 L +^RARPT(I):1 G:'$T LOCK I ($D(^RARPT(I))#2) L -^RARPT(I) G LOCK 36 S ^RARPT(I,0)=RALONGCN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1) 37 ;if case is member of a print set, then create sub-recs for file #74 38 G:'RAPRTSET LOCK1 39 I '$D(RARPTN) N RARPTN S RARPTN=RALONGCN 40 N RAXIT D PTR^RARTE2 ;create corresponding subrecs in ^RARPT() 41 ; 42 ;if RAERR unlock the report record (locked @LOCK), kill vars, & exit 43 I $D(RAERR) D LOCKR^RAHLTCPU(.RAERR,1) D KVAR Q ; *1 uR* 44 ; 45 LOCK1 I $D(RAESIG) S X=RAESIG,X1=$G(RAVERF),X2=RARPT D EN^XUSHSHP S RAESIG=X 46 K DA,DIE,DQ,DR S DA=RARPT,DIE="^RARPT(" 47 S DR="5////"_RARPTSTS ; rpt status 48 ;Verifier & Verified date will be set if RAVERF exists for new 49 ;reports, edits, and addendums. Date rpt entered and reported date 50 ;will be set for new reports, and not reset for edits and addendums 51 S DR=DR_";6////"_$S($D(RAEDIT):"",1:RADATIME) ; date/time rpt entered 52 S DR=DR_";7////"_$S($G(RAVERF)&(RARPTSTS="V"):RADATIME,1:"") ; v'fied date/time 53 S DR=DR_";8////"_$S($D(RAEDIT):"",1:RADATE) ; reported date 54 S DR=DR_";9////"_$S($G(RAVERF)&(RARPTSTS="V"):RAVERF,1:"") ; v'fying phys 55 S:$L($G(RATELENM)) DR=DR_";9.1////"_RATELENM ;Teleradiologist name - Patch 84 56 S:$L($G(RATELEPI)) DR=DR_";9.2////"_RATELEPI ;Teleradiologist NPI - Patch 84 57 S DR=DR_";11////"_$S($G(RATRANSC):RATRANSC,$G(RAVERF):RAVERF,1:"") ; transcriptionist 58 I $G(RAVERF),(RARPTSTS="V") S DR=DR_";17////"_$G(^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")) ;status changed to 'verified' by 59 ; D ^DIE K DA,DR ;BNT- Moved the DIE call down three lines due to a 60 ; problem found at Indy while testing PowerScribe. Site was doing a 61 ; local MUMPS cross reference on one of the nodes that are set below. 62 S $P(^RARPT(RARPT,0),"^",2)=RADFN,$P(^(0),"^",3)=(9999999.9999-RADTI),$P(^(0),"^",4)=$P(RALONGCN,"-",2) ;must set manually due uneditable 63 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 64 D ^DIE K DA,DR 65 ;don't file a Pri. Dx code for teleradiology reports in the released status (P84v11 bus. rule) 66 S RARELTEL=$S(($D(RATELE)#2)&(RARPTSTS="R"):1,1:"") 67 ; 68 ; 02/08/2008 GJC replaced $G w/($D(RADX)#2) p84 69 ; 11/15/2007 BAY/KAM RA*5*87 Rem Call 216332 Changed next line to $G 70 ; 09/07/2005 108405 KAM/BAY Removed('$D(RADENDUM)#2) from next line 71 I ($D(RADX)#2),RARELTEL="" D Q:($D(RAERR))#2 72 .;now a silent FM call w/p84 due to xref being killed when stuffing an identical Dx code 73 .;as the one already on file. 74 .N RAFDA,RAIENS S RAIENS=RACNI_","_RADTI_","_RADFN_"," 75 .S RAFDA(70.03,RAIENS,13)=RADX 76 .;lock the exam record, if the lock fails unlock the report record (locked @LOCK) & quit 77 .D LOCKX^RAHLTCPU(.RAERR) ;*1 lE* 78 .I ($D(RAERR)#2) D LOCKR^RAHLTCPU(.RAERR,1) Q ;*1 uR* 79 .K RAERR D FILE^DIE(,"RAFDA","RAERR") D LOCKX^RAHLTCPU(.RAERR,1) ;*1 uE* 80 .I ($D(RAERR("DIERR"))#2) D Q 81 ..;set the error dialog; unlock the report (locked @LOCK) *1 uR* 82 ..D LOCKR^RAHLTCPU(.RAERR,1) S RAERR=$G(RAERR("DIERR",1,"TEXT",1)) 83 ..Q 84 .S:$P(^RA(78.3,+RADX,0),"^",4)="y" RAAB=1 85 .Q 86 ; 87 K RARELTEL 88 ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx 89 I $D(RASECDX) D 90 . N RAX S RAX=0 91 . F S RAX=$O(RASECDX(RAX)) Q:RAX'>0 D 92 .. S:$P(^RA(78.3,+RAX,0),"^",4)="y" RAAB=1 93 ; 94 I '$D(RADENDUM)#2,($G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF"))!$G(^("RARESIDENT"))) D 95 . K DIE,DA S DR="" 96 . S RAPRIMAR=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")) I $D(^VA(200,"ARC","R",RAPRIMAR)) S DR="12////"_RAPRIMAR 97 . S RAPRIMAR=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF")) I $D(^VA(200,"ARC","S",RAPRIMAR)) S DR=$S(DR]"":DR_";",1:"")_"15////"_RAPRIMAR 98 . Q:'$G(DR) 99 . S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN 100 . D LOCKX^RAHLTCPU(.RAERR) ;*2 lE* 101 . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 102 . D ^DIE K DIE,DA,DR 103 . D LOCKX^RAHLTCPU(.RAERR,1) ;*2 uE* 104 . Q 105 ; 106 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RARPT I $G(RADPIECE),$P(^(0),"^",RADPIECE)="",('$D(RADENDUM)#2) D SETPHYS^RAHLO4 107 ; file impression text if present & not an addendum 108 I '$D(RADENDUM) D 109 . 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)) 110 . S:J ^RARPT(RARPT,"I",0)="^^"_J_"^"_J_"^"_RADATE 111 . Q 112 ; file report text if present & not an addendum 113 I '$D(RADENDUM) D 114 . 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)) 115 . S:J ^RARPT(RARPT,"R",0)="^^"_J_"^"_J_"^"_RADATE 116 . Q 117 ; if addendum, add addendum text to impression or report 118 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 119 ; 120 ; 121 ; Check for History from Dictation 122 ; If history sent, check if previous history exists. If previous 123 ; history then current history will follow adding 'Addendum:' before 124 ; the text. 125 I $O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0)) D 126 . S RACNT=+$O(^RARPT(RARPT,"H",9999999),-1),RAHSTNDE=RACNT+1 127 . S RANEW=$S(RACNT>0:0,1:1) 128 . S I=0 F S I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) Q:I'>0 D 129 . . S RACNT=RACNT+1 130 . . S RALN=$G(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) 131 . . S:'RANEW&(I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0))) RALN="Addendum: "_RALN ; if the first line, append 'Addendum:' 132 . . I (RAHSTNDE=RACNT),(RACNT>1) S ^RARPT(RARPT,"H",RACNT,0)=" ",RACNT=RACNT+1 133 . . S ^RARPT(RARPT,"H",RACNT,0)=RALN 134 . . Q 135 . S ^RARPT(RARPT,"H",0)="^^"_RACNT_"^"_RACNT_"^"_RADATE 136 . Q 137 ; 138 ; 139 I $P(^RARPT(RARPT,0),U,5)="V",$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ; women's health 140 G:'RAPRTSET UPACT ; the next section is for printsets only 141 ; copy DX (prim & sec), Prim Resid, Prim Staff 142 N RACNISAV,RA7 143 N RA13,RA12,RA15 ;prim dx, prim resid, prim staff, rpt pointer 144 S RACNISAV=RACNI,RA7=0 145 S RA13=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13),RA12=$P(^(0),U,12),RA15=$P(^(0),U,15) 146 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 147 S RACNI=RACNISAV 148 ;Update Activity Log 149 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(RAVERF):RAVERF,$G(RATRANSC):RATRANSC,1:"") D ^DIE K DA,DR,DE,DQ,DIE 150 ; use ix^dik to kill before setting xrefs 151 S DA=RARPT,DIK="^RARPT(",RAQUEUED=1 D IX^DIK 152 L -^RARPT(RARPT) ;(1 uR) conventionally unlock the report locked @LOCK 153 ; 154 ;If verified, update report & exam statuses; else, just update exam status 155 ;Note: be careful; exam locks are executed within UP1^RAUTL1! 156 I $D(RAMDV),RAMDV'="" D:RARPTSTS="V" UPSTAT^RAUTL0 D:RARPTSTS'="V" UP1^RAUTL1 157 D:'$D(RAERR)&($G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL") GENACK^RAHLTCPB ; generate 'ACK' message 158 ; 159 PACS ;If there are subscribers to RA RPT xxx events broadcast ORU mesages to those subscribers 160 ;via TASK^RAHLO4. If VOICE DICTATION AUTO-PRINT (#26) field is set to 'Y' print the report to 161 ;the printer defined in the REPORT PRINTER NAME (#10) field via VOICE^RAHLO4. 162 I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D TASK^RAHLO4,VOICE^RAHLO4 163 ; 164 KVAR K RAAB,RAEDIT,RAESIG,RAQUEUED,RARPT,RAHIST 165 Q 166 ; 1 RAHLO1 ;HIRMFO/GJC/BNT-File rpt (data from bridge program) ;6/25/04 11:49 2 ;;5.0;Radiology/Nuclear Medicine;**4,5,12,17,21,27,48,55,66**;Mar 16, 1998 3 ; 09/07/2005 108405 - KAM/BAY Allow Radiology to accept dx codes from Talk Technology 4 ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx 5 ; This routine uses the following IA: 6 ; #4793 - ^WVRALINK (private) 7 FILE ;Create Entry in File 74 and File Data 8 I '$D(ZTQUEUED) N ZTQUEUED S ZTQUEUED="1^dummy to suppress screen displays in UP2^RAUTL1 and elsewhere" 9 I '$D(RAQUIET) N RAQUIET S RAQUIET="1^dummy to suppress screen display in PTR^RARTE2" 10 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 11 S RADPIECE=$S($D(^VA(200,"ARC","S",+$G(RAVERF))):15,$D(^VA(200,"ARC","R",+$G(RAVERF))):12,1:"") 12 N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR 13 D EN2^RAUTL20(.RAMEMARR) ; 04/30/99 always recalculate RAPRTSET 14 ; If rpt (either stub or real) exists, skip creating a new file 74 entry 15 I RARPT,$D(^RARPT(RARPT,0)) S RASAV=RARPT D FILETST^RAHLO4 Q:$D(RAERR) D S RARPT=RASAV K RASAV G LOCK1 16 . ; must save off RARPT, RAVERF and other RA* variables because 17 . ; they are being killed off somewhere in the 'Unverify A Report' 18 . ; option. 19 . N RADFN,RADTI,RACNI,RARPTSTS,RASSN,RADATE,RALONGCN,RAVERF 20 . ; if report isn't a stub report, then consider it being edited 21 . S:'$$STUB^RAEDCN1(RARPT) RAEDIT=1 22 . I $D(RADENDUM)#2,($P(^RARPT(RARPT,0),"^",5)="V") D Q ; edit on current record (for activity log) 23 .. D UNVER^RARTE1(RARPT) 24 .. Q 25 . K ^RARPT(RARPT,"I"),^("R"),^("H") 26 . Q 27 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 28 NEW1 S I=$P(^RARPT(0),"^",3) 29 LOCK S I=I+1 L +^RARPT(I):1 I '$T!($D(^RARPT(I)))!($D(^RARPT("B",I))) L -^RARPT(I) G LOCK 30 S ^RARPT(I,0)=RALONGCN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1) 31 ;if case is member of a print set, then create sub-recs for file #74 32 G:'RAPRTSET LOCK1 33 I '$D(RARPTN) N RARPTN S RARPTN=RALONGCN 34 N RAXIT D PTR^RARTE2 ;create corresponding subrecs in ^RARPT() 35 I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI) D KVAR Q ;unlck & clear vars 36 LOCK1 I $D(RAESIG) S X=RAESIG,X1=$G(RAVERF),X2=RARPT D EN^XUSHSHP S RAESIG=X 37 K DA,DIE,DQ,DR S DA=RARPT,DIE="^RARPT(" 38 S DR="5////"_RARPTSTS ; rpt status 39 ;Verifier & Verified date will be set if RAVERF exists for new 40 ;reports, edits, and addendums. Date rpt entered and reported date 41 ;will be set for new reports, and not reset for edits and addendums 42 S DR=DR_";6////"_$S($D(RAEDIT):"",1:RADATIME) ; date/time rpt entered 43 S DR=DR_";7////"_$S($G(RAVERF)&(RARPTSTS="V"):RADATIME,1:"") ; v'fied date/time 44 S DR=DR_";8////"_$S($D(RAEDIT):"",1:RADATE) ; reported date 45 S DR=DR_";9////"_$S($G(RAVERF)&(RARPTSTS="V"):RAVERF,1:"") ; v'fying phys 46 S DR=DR_";11////"_$S($G(RATRANSC):RATRANSC,$G(RAVERF):RAVERF,1:"") ; transcriptionist 47 I $G(RAVERF),(RARPTSTS="V") S DR=DR_";17////"_$G(^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")) ;status changed to 'verified' by 48 ; D ^DIE K DA,DR ;BNT- Moved the DIE call down three lines due to a 49 ; problem found at Indy while testing PowerScribe. Site was doing a 50 ; local MUMPS cross reference on one of the nodes that are set below. 51 S $P(^RARPT(RARPT,0),"^",2)=RADFN,$P(^(0),"^",3)=(9999999.9999-RADTI),$P(^(0),"^",4)=$P(RALONGCN,"-",2) ;must set manually due uneditable 52 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 53 D ^DIE K DA,DR 54 ; 09/07/2005 108405 KAM/BAY Removed('$D(RADENDUM)#2) from next line 55 I $D(RADX) D 56 . K DIE,DA,DR S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN 57 . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 58 . S DR="13////"_RADX D ^DIE K DIE,DA,DR 59 . S:$P(^RA(78.3,+RADX,0),"^",4)="y" RAAB=1 60 . Q 61 ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx 62 I $D(RASECDX) D 63 . N RAX S RAX=0 64 . F S RAX=$O(RASECDX(RAX)) Q:RAX'>0 D 65 .. S:$P(^RA(78.3,+RAX,0),"^",4)="y" RAAB=1 66 ; 67 I '$D(RADENDUM)#2,($G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF"))!$G(^("RARESIDENT"))) D 68 . K DIE,DA S DR="" 69 . S RAPRIMAR=+$G(^TMP("RARPT-REC",$J,RASUB,"RARESIDENT")) I $D(^VA(200,"ARC","R",RAPRIMAR)) S DR="12////"_RAPRIMAR 70 . S RAPRIMAR=+$G(^TMP("RARPT-REC",$J,RASUB,"RASTAFF")) I $D(^VA(200,"ARC","S",RAPRIMAR)) S DR=$S(DR]"":DR_";",1:"")_"15////"_RAPRIMAR 71 . Q:'$G(DR) 72 . S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN 73 . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," 74 . D ^DIE K DIE,DA,DR 75 . Q 76 ; 77 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RARPT I $G(RADPIECE),$P(^(0),"^",RADPIECE)="",('$D(RADENDUM)#2) D SETPHYS^RAHLO4 78 ; file impression text if present & not an addendum 79 I '$D(RADENDUM) D 80 . 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)) 81 . S:J ^RARPT(RARPT,"I",0)="^^"_J_"^"_J_"^"_RADATE 82 . Q 83 ; file report text if present & not an addendum 84 I '$D(RADENDUM) D 85 . 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)) 86 . S:J ^RARPT(RARPT,"R",0)="^^"_J_"^"_J_"^"_RADATE 87 . Q 88 ; if addendum, add addendum text to impression or report 89 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 90 ; 91 ; 92 ; Check for History from Dictation 93 ; If history sent, check if previous history exists. If previous 94 ; history then current history will follow adding 'Addendum:' before 95 ; the text. 96 I $O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0)) D 97 . S RACNT=+$O(^RARPT(RARPT,"H",9999999),-1),RAHSTNDE=RACNT+1 98 . S RANEW=$S(RACNT>0:0,1:1) 99 . S I=0 F S I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) Q:I'>0 D 100 . . S RACNT=RACNT+1 101 . . S RALN=$G(^TMP("RARPT-REC",$J,RASUB,"RAHIST",I)) 102 . . S:'RANEW&(I=$O(^TMP("RARPT-REC",$J,RASUB,"RAHIST",0))) RALN="Addendum: "_RALN ; if the first line, append 'Addendum:' 103 . . I (RAHSTNDE=RACNT),(RACNT>1) S ^RARPT(RARPT,"H",RACNT,0)=" ",RACNT=RACNT+1 104 . . S ^RARPT(RARPT,"H",RACNT,0)=RALN 105 . . Q 106 . S ^RARPT(RARPT,"H",0)="^^"_RACNT_"^"_RACNT_"^"_RADATE 107 . Q 108 ; 109 ; 110 I $P(^RARPT(RARPT,0),U,5)="V",$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ; women's health 111 G:'RAPRTSET UPACT ; the next section is for printsets only 112 ; copy DX (prim & sec), Prim Resid, Prim Staff 113 N RACNISAV,RA7 114 N RA13,RA12,RA15 ;prim dx, prim resid, prim staff, rpt pointer 115 S RACNISAV=RACNI,RA7=0 116 S RA13=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13),RA12=$P(^(0),U,12),RA15=$P(^(0),U,15) 117 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 118 S RACNI=RACNISAV 119 L -^RADPT(RADFN,"DT",RADTI) ;unlock after pce 17 is set in all cases of this printset 120 ;Update Activity Log 121 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 122 ; use ix^dik to kill before setting xrefs 123 S DA=RARPT,DIK="^RARPT(",RAQUEUED=1 D IX^DIK 124 ; if verfd, update rpt & exam statuses; else, just update exam status 125 I $D(RAMDV),RAMDV'="" D:RARPTSTS="V" UPSTAT^RAUTL0 D:RARPTSTS'="V" UP1^RAUTL1 126 L -^RARPT(RARPT) D:'$D(RAERR)&($G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL") GENACK^RAHLTCPB ; generate 'ACK' message 127 ; line pacs is for 2 tasks: hl7 msg'g & voice verified rpt printout 128 PACS I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D TASK^RAHLO4,VOICE^RAHLO4 129 KVAR K RAAB,RAEDIT,RAESIG,RAQUEUED,RARPT,RAHIST 130 Q
Note:
See TracChangeset
for help on using the changeset viewer.
