Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RA84POS

RA84POS.m

Go to the documentation of this file. 
  1. RA84POS ;Hines OI/GJC - Post-init Driver, patch 84 ;01/07/06  06:32
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;**84**;Mar 16, 1998;Build 13
  1.  ;
  1.  ;Integration Agreements
  1.  ;----------------------
  1.  ;$$FIND1^DIC(2051); FILE^DIE(2053); UPDATE^DIE(2053); BMES^XPDUTL(10141)
  1.  ;
  1. EN ;Entry point
  1.  N DIERR,RAERR,RAF,RAFDA,RAHLAPP,RAIEN,RATXT,RAY
  1.  S:'$D(U) U="^"
  1.  ;Find the IEN of 'RA-SCIMAGE-TCP' in the RAD/NUC MED HL7 APPLICATION EXCEPTION (#79.7) file.
  1.  ;Is 'RA-SCIMAGE-TCP' already in 79.7? If not find the IEN in file 771 & add it to file 79.7.
  1.  S RAHLAPP=$$FIND1^DIC(79.7,"","X","RA-SCIMAGE-TCP")
  1.  I 'RAHLAPP D
  1.  .S RAHLAPP=$$FIND1^DIC(771,"","X","RA-SCIMAGE-TCP")
  1.  .S RAFDA(79.7,"+1,",.01)=RAHLAPP,RAFDA(79.7,"+1,",1)=1
  1.  .S RAIEN(1)=RAHLAPP D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
  1.  .S:$G(RAIEN(1))'>0 RAERR("DIERR")=""
  1.  .Q
  1.  ;
  1.  I ($D(RAERR("DIERR"))#2) D  Q
  1.  .S RATXT(1)="'RA-SCIMAGE-TCP' is not a record in the RAD/NUC MED HL7 APPLICATION EXCEPTION"
  1.  .S RATXT(2)="(#79.7) file. Please contact the national Radiology development team about this"
  1.  .S RATXT(3)="issue." D BMES^XPDUTL(.RATXT)
  1.  .Q
  1.  ;
  1.  ;The 'TELERADIOLOGY APPLICATION' (fld: 1) for 'RA-SCIMAGE-TCP' should be defined as '1' or Yes
  1.  I $P(^RA(79.7,RAHLAPP,0),U,2)'=1 D
  1.  .S RAFDA(79.7,RAHLAPP_",",1)=1 ;internal value
  1.  .D FILE^DIE("","RAFDA","RAERR") S RATXT(1)=""
  1.  .S:($D(RAERR("DIERR")))#2 RATXT(2)="Error setting 'RA-SCIMAGE-TCP' as a 'TELERADIOLOGY' application type."
  1.  .S:$G(RATXT(2))="" RATXT(2)="'RA-SCIMAGE-TCP' is now defined as a 'TELERADIOLOGY' application type."
  1.  .D BMES^XPDUTL(.RATXT)
  1.  .Q
  1.  ;
  1.  ;The 'APPLICATION TYPE' (fld: 1.3) for 'RA-SCIMAGE-TCP' should be defined as 'S' for
  1.  ;'Speech Recognition'.
  1.  I $P(^RA(79.7,RAHLAPP,0),U,5)'="S" D
  1.  .S RAFDA(79.7,RAHLAPP_",",1.3)="S" ;internal value
  1.  .D FILE^DIE("","RAFDA","RAERR") S RATXT(1)=""
  1.  .S:($D(RAERR("DIERR")))#2 RATXT(2)="Error setting 'RA-SCIMAGE-TCP' as a 'Speech Recognition' APPLICATION TYPE."
  1.  .S:$G(RATXT(2))="" RATXT(2)="'RA-SCIMAGE-TCP' is now defined as a 'Speech Recognition' APPLICATION TYPE."
  1.  .D BMES^XPDUTL(.RATXT)
  1.  .Q
  1.  ;
  1.  K DIERR,RAERR,RAFDA,RATXT
  1.  ;update the following fields in the RAD/NUC MED HL7 APPLICATION EXCEPTION
  1.  ;(#79.7) file with the most recent Dx Codes (999-1003 series implemeted with V9)
  1.  ; DEFAULT DX FOR 'R' REPORT (#2.1)
  1.  ; DEFAULT DX FOR 'F' REPORT (#2.2)
  1.  I $G(^RA(78.3,999,0))="TELERADIOLOGY, NOT YET DICTATED^^N^n" D
  1.  .S RAFDA(79.7,RAHLAPP_",",2.1)=999
  1.  .I $G(^RA(78.3,1000,0))="NO ALERT REQUIRED^^N^n" S RAF=1,RAFDA(79.7,RAHLAPP_",",2.2)=1000
  1.  .D FILE^DIE("","RAFDA","RAERR")
  1.  .I ($D(RAERR("DIERR")))#2 D
  1.  ..S RAY=0 F  S RAY=$O(RAERR("DIERR",RAY)) Q:'RAY  S RATXT(RAY)=$G(RAERR("DIERR",RAY,"TEXT",1))
  1.  ..Q
  1.  .E  D
  1.  ..S RATXT(1)="'TELERADIOLOGY, NOT YET DICTATED' added as the 'DEFAULT DX FOR 'R' REPORT' value."
  1.  ..S:$G(RAF)=1 RATXT(2)="'NO ALERT REQUIRED' added as the 'DEFAULT DX FOR 'F' REPORT' value."
  1.  ..Q
  1.  .D BMES^XPDUTL(.RATXT)
  1.  .Q
  1.  ;
  1. ILOC ; assign active imaging locations to RADIOLOGY,OUTSIDE SERVICE
  1.  ;
  1.  N DIERR,RAERR,RAFDA,RAIEN,RATODAY
  1.  S (RAIEN,RAIEN(0))=$$FIND1^DIC(200,"","X","RADIOLOGY,OUTSIDE SERVICE"),RATODAY=$$DT^XLFDT()
  1.  I RAIEN=0!($D(DIERR)#2) D  Q
  1.  .D BMES^XPDUTL("Failed NEW PERSON file lookup on: RADIOLOGY,OUTSIDE SERVICE") Q
  1.  ;
  1.  ;if this i-loc have been assigned to RADIOLOGY,OUTSIDE SERVICE quit (do not create duplicates)
  1.  Q:$O(^VA(200,RAIEN,"RAL",0))
  1.  ;
  1.  ;find only active radiology imaging locations...
  1.  N RAX,RAY S RAY=0,RAIEN=","_RAIEN_","
  1.  F  S RAY=$O(^RA(79.1,RAY)) Q:'RAY  S RAX=$G(^(RAY,0)) D
  1.  .I $P(RAX,U,19),($P(RAX,U,19)'>RATODAY) Q  ;inactive location
  1.  .S RAFDA(200.074,"+"_RAY_RAIEN,.01)=RAY Q
  1.  ;
  1.  Q:'($D(RAFDA(200.074))\10)  ;quit there is no data to file
  1.  ;
  1.  ;lock the RADIOLOGY,OUTSIDE SERVICE record in file 200, exit gracefully if locked by another
  1.  L +^VA(200,RAIEN(0)):$G(DILOCKTM,3)
  1.  I '$T D BMES^XPDUTL("RADIOLOGY,OUTSIDE SERVICE is locked by another user!") Q
  1.  ;
  1.  D UPDATE^DIE("","RAFDA","","RAERR")
  1.  I $D(RAERR("DIERR"))#2 D
  1.  .N RATXT S RATXT(1)="Error assigning imaging locations to RADIOLOGY,OUTSIDE SERVICE."
  1.  .S RATXT(2)=$G(RAERR("DIERR","1","TEXT",1)) D BMES^XPDUTL(.RATXT) Q
  1.  E  D BMES^XPDUTL("Imaging locations have been assigned to RADIOLOGY,OUTSIDE SERVICE.")
  1.  ;
  1.  ;unlock the RADIOLOGY,OUTSIDE SERVICE record in the NEW PERSON file
  1.  L -^VA(200,RAIEN(0))
  1.  Q
  1.  ;