Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO1.m (modified) (8 diffs)

FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLO1.m

@@ -1 +1 @@
 RAHLO1 ;HIRMFO/GJC/BNT-File rpt (data from bridge program) ;6/25/04  11:49
- ;;5.0;Radiology/Nuclear Medicine;**4,5,12,17,21,27,48,55,66,87,84**;Mar 16, 1998;Build 13
- ; 11/15/2007 BAY/KAM RA*5*87 Rem Call 216332 Correct UNDEF on null dx code
+ ;;5.0;Radiology/Nuclear Medicine;**4,5,12,17,21,27,48,55,66**;Mar 16, 1998
  ; 09/07/2005 108405 - KAM/BAY Allow Radiology to accept dx codes from Talk Technology
- ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx
- ;
- ;Integration Agreements
- ;----------------------
- ;DIE(10018); ,FILE^DIE(2053); IX^DIK(10013); CREATE^WVRALINK(4793); $$NOW^XLFDT(10103)
- ;EN^XUSHSHP(10045)
- ;
+ ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx 
+ ; This routine uses the following IA:
+ ; #4793  - ^WVRALINK         (private)
 FILE ;Create Entry in File 74 and File Data
  I '$D(ZTQUEUED) N ZTQUEUED S ZTQUEUED="1^dummy to suppress screen displays in UP2^RAUTL1 and elsewhere"
@@ -17 +12 @@
  N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
  D EN2^RAUTL20(.RAMEMARR) ; 04/30/99 always recalculate RAPRTSET
- ; If the report (stub/real) exists, unverify the existing report... Else create a new report
- I RARPT,$D(^RARPT(RARPT,0)) S RASAV=RARPT D  S RARPT=RASAV K RASAV Q:$D(RAERR)  G LOCK1
+ ; If rpt (either stub or real) exists, skip creating a new file 74 entry
+ I RARPT,$D(^RARPT(RARPT,0)) S RASAV=RARPT D FILETST^RAHLO4 Q:$D(RAERR)  D  S RARPT=RASAV K RASAV G LOCK1
  . ; must save off RARPT, RAVERF and other RA* variables because
  . ; they are being killed off somewhere in the 'Unverify A Report'
- . ; option. 'Unverify A Report' does lock the the report record in file 74!
+ . ; option.
  . N RADFN,RADTI,RACNI,RARPTSTS,RASSN,RADATE,RALONGCN,RAVERF
  . ; if report isn't a stub report, then consider it being edited
@@ -30 +25 @@
  . K ^RARPT(RARPT,"I"),^("R"),^("H")
  . Q
- ; New report logic @NEW1
+ 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
 NEW1 S I=$P(^RARPT(0),"^",3)
- ;since this is a new report (not linked to an exam), directly lock the new record *1 lR*
-LOCK S I=I+1 L +^RARPT(I):1 G:'$T LOCK I ($D(^RARPT(I))#2) L -^RARPT(I) G LOCK
+LOCK S I=I+1 L +^RARPT(I):1 I '$T!($D(^RARPT(I)))!($D(^RARPT("B",I))) L -^RARPT(I) G LOCK
  S ^RARPT(I,0)=RALONGCN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1)
  ;if case is member of a print set, then create sub-recs for file #74
@@ -39 +33 @@
  I '$D(RARPTN) N RARPTN S RARPTN=RALONGCN
  N RAXIT D PTR^RARTE2 ;create corresponding subrecs in ^RARPT()
- ;
- ;if RAERR unlock the report record (locked @LOCK), kill vars, & exit
- I $D(RAERR) D LOCKR^RAHLTCPU(.RAERR,1) D KVAR Q  ; *1 uR*
- ;
+ I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI) D KVAR Q  ;unlck & clear vars
 LOCK1 I $D(RAESIG) S X=RAESIG,X1=$G(RAVERF),X2=RARPT D EN^XUSHSHP S RAESIG=X
  K DA,DIE,DQ,DR S DA=RARPT,DIE="^RARPT("
@@ -53 +44 @@
  S DR=DR_";8////"_$S($D(RAEDIT):"",1:RADATE) ; reported date
  S DR=DR_";9////"_$S($G(RAVERF)&(RARPTSTS="V"):RAVERF,1:"") ; v'fying phys
- S:$L($G(RATELENM)) DR=DR_";9.1////"_RATELENM ;Teleradiologist name - Patch 84
- S:$L($G(RATELEPI)) DR=DR_";9.2////"_RATELEPI ;Teleradiologist NPI  - Patch 84
  S DR=DR_";11////"_$S($G(RATRANSC):RATRANSC,$G(RAVERF):RAVERF,1:"") ; transcriptionist
  I $G(RAVERF),(RARPTSTS="V") S DR=DR_";17////"_$G(^TMP("RARPT-REC",$J,RASUB,"RAWHOCHANGE")) ;status changed to 'verified' by
@@ -63 +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
  D ^DIE K DA,DR
- ;don't file a Pri. Dx code for teleradiology reports in the released status (P84v11 bus. rule)
- S RARELTEL=$S(($D(RATELE)#2)&(RARPTSTS="R"):1,1:"")
- ;
- ; 02/08/2008 GJC replaced $G w/($D(RADX)#2) p84
- ; 11/15/2007 BAY/KAM RA*5*87 Rem Call 216332 Changed next line to $G
  ; 09/07/2005 108405 KAM/BAY Removed('$D(RADENDUM)#2) from next line
- I ($D(RADX)#2),RARELTEL="" D  Q:($D(RAERR))#2
- .;now a silent FM call w/p84 due to xref being killed when stuffing an identical Dx code
- .;as the one already on file.
- .N RAFDA,RAIENS S RAIENS=RACNI_","_RADTI_","_RADFN_","
- .S RAFDA(70.03,RAIENS,13)=RADX
- .;lock the exam record, if the lock fails unlock the report record (locked @LOCK) & quit
- .D LOCKX^RAHLTCPU(.RAERR) ;*1 lE*
- .I ($D(RAERR)#2) D LOCKR^RAHLTCPU(.RAERR,1) Q  ;*1 uR*
- .K RAERR D FILE^DIE(,"RAFDA","RAERR") D LOCKX^RAHLTCPU(.RAERR,1) ;*1 uE*
- .I ($D(RAERR("DIERR"))#2) D  Q
- ..;set the error dialog; unlock the report (locked @LOCK) *1 uR*
- ..D LOCKR^RAHLTCPU(.RAERR,1) S RAERR=$G(RAERR("DIERR",1,"TEXT",1))
- ..Q
- .S:$P(^RA(78.3,+RADX,0),"^",4)="y" RAAB=1
- .Q
- ;
- K RARELTEL
+ I $D(RADX) D
+ . K DIE,DA,DR S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN
+ . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
+ . S DR="13////"_RADX D ^DIE K DIE,DA,DR
+ . S:$P(^RA(78.3,+RADX,0),"^",4)="y" RAAB=1
+ . Q
  ; 09/29/2005 114302 KAM/BAY Code Added to trigger alert on 2ndary dx
  I $D(RASECDX) D
@@ -98 +71 @@
  . Q:'$G(DR)
  . S DA=RACNI,DA(1)=RADTI,DA(2)=RADFN
- . D LOCKX^RAHLTCPU(.RAERR) ;*2 lE*
  . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
  . D ^DIE K DIE,DA,DR
- . D LOCKX^RAHLTCPU(.RAERR,1) ;*2 uE*
  . Q
  ;
@@ -146 +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
  S RACNI=RACNISAV
+ L -^RADPT(RADFN,"DT",RADTI) ;unlock after pce 17 is set in all cases of this printset
  ;Update Activity Log
-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
+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
  ; use ix^dik to kill before setting xrefs
  S DA=RARPT,DIK="^RARPT(",RAQUEUED=1 D IX^DIK
- L -^RARPT(RARPT) ;(1 uR) conventionally unlock the report locked @LOCK
- ;
- ;If verified, update report & exam statuses; else, just update exam status
- ;Note: be careful; exam locks are executed within UP1^RAUTL1!
+ ; if verfd, update rpt & exam statuses; else, just update exam status
  I $D(RAMDV),RAMDV'="" D:RARPTSTS="V" UPSTAT^RAUTL0 D:RARPTSTS'="V" UP1^RAUTL1
- D:'$D(RAERR)&($G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL") GENACK^RAHLTCPB ; generate 'ACK' message
- ;
-PACS ;If there are subscribers to RA RPT xxx events broadcast ORU mesages to those subscribers
- ;via TASK^RAHLO4. If VOICE DICTATION AUTO-PRINT (#26) field is set to 'Y' print the report to
- ;the printer defined in the REPORT PRINTER NAME (#10) field via VOICE^RAHLO4.
- I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D TASK^RAHLO4,VOICE^RAHLO4
- ;
+ L -^RARPT(RARPT) D:'$D(RAERR)&($G(^TMP("RARPT-REC",$J,RASUB,"VENDOR"))'="KURZWEIL") GENACK^RAHLTCPB ; generate 'ACK' message
+ ; line pacs is for 2 tasks: hl7 msg'g  &  voice verified rpt printout
+PACS I ($P(^RARPT(RARPT,0),U,5)="V")!($P(^(0),U,5)="R") D TASK^RAHLO4,VOICE^RAHLO4
 KVAR K RAAB,RAEDIT,RAESIG,RAQUEUED,RARPT,RAHIST
  Q
- ;