RA84POS ;Hines OI/GJC - Post-init Driver, patch 84 ;01/07/06 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**84**;Mar 16, 1998;Build 13
;
;Integration Agreements
;----------------------
;$$FIND1^DIC(2051); FILE^DIE(2053); UPDATE^DIE(2053); BMES^XPDUTL(10141)
;
EN ;Entry point
N DIERR,RAERR,RAF,RAFDA,RAHLAPP,RAIEN,RATXT,RAY
S:'$D(U) U="^"
;Find the IEN of 'RA-SCIMAGE-TCP' in the RAD/NUC MED HL7 APPLICATION EXCEPTION (#79.7) file.
;Is 'RA-SCIMAGE-TCP' already in 79.7? If not find the IEN in file 771 & add it to file 79.7.
S RAHLAPP=$$FIND1^DIC(79.7,"","X","RA-SCIMAGE-TCP")
I 'RAHLAPP D
.S RAHLAPP=$$FIND1^DIC(771,"","X","RA-SCIMAGE-TCP")
.S RAFDA(79.7,"+1,",.01)=RAHLAPP,RAFDA(79.7,"+1,",1)=1
.S RAIEN(1)=RAHLAPP D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
.S:$G(RAIEN(1))'>0 RAERR("DIERR")=""
.Q
;
I ($D(RAERR("DIERR"))#2) D Q
.S RATXT(1)="'RA-SCIMAGE-TCP' is not a record in the RAD/NUC MED HL7 APPLICATION EXCEPTION"
.S RATXT(2)="(#79.7) file. Please contact the national Radiology development team about this"
.S RATXT(3)="issue." D BMES^XPDUTL(.RATXT)
.Q
;
;The 'TELERADIOLOGY APPLICATION' (fld: 1) for 'RA-SCIMAGE-TCP' should be defined as '1' or Yes
I $P(^RA(79.7,RAHLAPP,0),U,2)'=1 D
.S RAFDA(79.7,RAHLAPP_",",1)=1 ;internal value
.D FILE^DIE("","RAFDA","RAERR") S RATXT(1)=""
.S:($D(RAERR("DIERR")))#2 RATXT(2)="Error setting 'RA-SCIMAGE-TCP' as a 'TELERADIOLOGY' application type."
.S:$G(RATXT(2))="" RATXT(2)="'RA-SCIMAGE-TCP' is now defined as a 'TELERADIOLOGY' application type."
.D BMES^XPDUTL(.RATXT)
.Q
;
;The 'APPLICATION TYPE' (fld: 1.3) for 'RA-SCIMAGE-TCP' should be defined as 'S' for
;'Speech Recognition'.
I $P(^RA(79.7,RAHLAPP,0),U,5)'="S" D
.S RAFDA(79.7,RAHLAPP_",",1.3)="S" ;internal value
.D FILE^DIE("","RAFDA","RAERR") S RATXT(1)=""
.S:($D(RAERR("DIERR")))#2 RATXT(2)="Error setting 'RA-SCIMAGE-TCP' as a 'Speech Recognition' APPLICATION TYPE."
.S:$G(RATXT(2))="" RATXT(2)="'RA-SCIMAGE-TCP' is now defined as a 'Speech Recognition' APPLICATION TYPE."
.D BMES^XPDUTL(.RATXT)
.Q
;
K DIERR,RAERR,RAFDA,RATXT
;update the following fields in the RAD/NUC MED HL7 APPLICATION EXCEPTION
;(#79.7) file with the most recent Dx Codes (999-1003 series implemeted with V9)
; DEFAULT DX FOR 'R' REPORT (#2.1)
; DEFAULT DX FOR 'F' REPORT (#2.2)
I $G(^RA(78.3,999,0))="TELERADIOLOGY, NOT YET DICTATED^^N^n" D
.S RAFDA(79.7,RAHLAPP_",",2.1)=999
.I $G(^RA(78.3,1000,0))="NO ALERT REQUIRED^^N^n" S RAF=1,RAFDA(79.7,RAHLAPP_",",2.2)=1000
.D FILE^DIE("","RAFDA","RAERR")
.I ($D(RAERR("DIERR")))#2 D
..S RAY=0 F S RAY=$O(RAERR("DIERR",RAY)) Q:'RAY S RATXT(RAY)=$G(RAERR("DIERR",RAY,"TEXT",1))
..Q
.E D
..S RATXT(1)="'TELERADIOLOGY, NOT YET DICTATED' added as the 'DEFAULT DX FOR 'R' REPORT' value."
..S:$G(RAF)=1 RATXT(2)="'NO ALERT REQUIRED' added as the 'DEFAULT DX FOR 'F' REPORT' value."
..Q
.D BMES^XPDUTL(.RATXT)
.Q
;
ILOC ; assign active imaging locations to RADIOLOGY,OUTSIDE SERVICE
;
N DIERR,RAERR,RAFDA,RAIEN,RATODAY
S (RAIEN,RAIEN(0))=$$FIND1^DIC(200,"","X","RADIOLOGY,OUTSIDE SERVICE"),RATODAY=$$DT^XLFDT()
I RAIEN=0!($D(DIERR)#2) D Q
.D BMES^XPDUTL("Failed NEW PERSON file lookup on: RADIOLOGY,OUTSIDE SERVICE") Q
;
;if this i-loc have been assigned to RADIOLOGY,OUTSIDE SERVICE quit (do not create duplicates)
Q:$O(^VA(200,RAIEN,"RAL",0))
;
;find only active radiology imaging locations...
N RAX,RAY S RAY=0,RAIEN=","_RAIEN_","
F S RAY=$O(^RA(79.1,RAY)) Q:'RAY S RAX=$G(^(RAY,0)) D
.I $P(RAX,U,19),($P(RAX,U,19)'>RATODAY) Q ;inactive location
.S RAFDA(200.074,"+"_RAY_RAIEN,.01)=RAY Q
;
Q:'($D(RAFDA(200.074))\10) ;quit there is no data to file
;
;lock the RADIOLOGY,OUTSIDE SERVICE record in file 200, exit gracefully if locked by another
L +^VA(200,RAIEN(0)):$G(DILOCKTM,3)
I '$T D BMES^XPDUTL("RADIOLOGY,OUTSIDE SERVICE is locked by another user!") Q
;
D UPDATE^DIE("","RAFDA","","RAERR")
I $D(RAERR("DIERR"))#2 D
.N RATXT S RATXT(1)="Error assigning imaging locations to RADIOLOGY,OUTSIDE SERVICE."
.S RATXT(2)=$G(RAERR("DIERR","1","TEXT",1)) D BMES^XPDUTL(.RATXT) Q
E D BMES^XPDUTL("Imaging locations have been assigned to RADIOLOGY,OUTSIDE SERVICE.")
;
;unlock the RADIOLOGY,OUTSIDE SERVICE record in the NEW PERSON file
L -^VA(200,RAIEN(0))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA84POS 4377 printed Mar 13, 2025@21:38:17 Page 2
RA84POS ;Hines OI/GJC - Post-init Driver, patch 84 ;01/07/06 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**84**;Mar 16, 1998;Build 13
+1 ;
+2 ;Integration Agreements
+3 ;----------------------
+4 ;$$FIND1^DIC(2051); FILE^DIE(2053); UPDATE^DIE(2053); BMES^XPDUTL(10141)
+5 ;
EN ;Entry point
+1 NEW DIERR,RAERR,RAF,RAFDA,RAHLAPP,RAIEN,RATXT,RAY
+2 if '$DATA(U)
SET U="^"
+3 ;Find the IEN of 'RA-SCIMAGE-TCP' in the RAD/NUC MED HL7 APPLICATION EXCEPTION (#79.7) file.
+4 ;Is 'RA-SCIMAGE-TCP' already in 79.7? If not find the IEN in file 771 & add it to file 79.7.
+5 SET RAHLAPP=$$FIND1^DIC(79.7,"","X","RA-SCIMAGE-TCP")
+6 IF 'RAHLAPP
Begin DoDot:1
+7 SET RAHLAPP=$$FIND1^DIC(771,"","X","RA-SCIMAGE-TCP")
+8 SET RAFDA(79.7,"+1,",.01)=RAHLAPP
SET RAFDA(79.7,"+1,",1)=1
+9 SET RAIEN(1)=RAHLAPP
DO UPDATE^DIE("","RAFDA","RAIEN","RAERR")
+10 if $GET(RAIEN(1))'>0
SET RAERR("DIERR")=""
+11 QUIT
End DoDot:1
+12 ;
+13 IF ($DATA(RAERR("DIERR"))#2)
Begin DoDot:1
+14 SET RATXT(1)="'RA-SCIMAGE-TCP' is not a record in the RAD/NUC MED HL7 APPLICATION EXCEPTION"
+15 SET RATXT(2)="(#79.7) file. Please contact the national Radiology development team about this"
+16 SET RATXT(3)="issue."
DO BMES^XPDUTL(.RATXT)
+17 QUIT
End DoDot:1
QUIT
+18 ;
+19 ;The 'TELERADIOLOGY APPLICATION' (fld: 1) for 'RA-SCIMAGE-TCP' should be defined as '1' or Yes
+20 IF $PIECE(^RA(79.7,RAHLAPP,0),U,2)'=1
Begin DoDot:1
+21 ;internal value
SET RAFDA(79.7,RAHLAPP_",",1)=1
+22 DO FILE^DIE("","RAFDA","RAERR")
SET RATXT(1)=""
+23 if ($DATA(RAERR("DIERR")))#2
SET RATXT(2)="Error setting 'RA-SCIMAGE-TCP' as a 'TELERADIOLOGY' application type."
+24 if $GET(RATXT(2))=""
SET RATXT(2)="'RA-SCIMAGE-TCP' is now defined as a 'TELERADIOLOGY' application type."
+25 DO BMES^XPDUTL(.RATXT)
+26 QUIT
End DoDot:1
+27 ;
+28 ;The 'APPLICATION TYPE' (fld: 1.3) for 'RA-SCIMAGE-TCP' should be defined as 'S' for
+29 ;'Speech Recognition'.
+30 IF $PIECE(^RA(79.7,RAHLAPP,0),U,5)'="S"
Begin DoDot:1
+31 ;internal value
SET RAFDA(79.7,RAHLAPP_",",1.3)="S"
+32 DO FILE^DIE("","RAFDA","RAERR")
SET RATXT(1)=""
+33 if ($DATA(RAERR("DIERR")))#2
SET RATXT(2)="Error setting 'RA-SCIMAGE-TCP' as a 'Speech Recognition' APPLICATION TYPE."
+34 if $GET(RATXT(2))=""
SET RATXT(2)="'RA-SCIMAGE-TCP' is now defined as a 'Speech Recognition' APPLICATION TYPE."
+35 DO BMES^XPDUTL(.RATXT)
+36 QUIT
End DoDot:1
+37 ;
+38 KILL DIERR,RAERR,RAFDA,RATXT
+39 ;update the following fields in the RAD/NUC MED HL7 APPLICATION EXCEPTION
+40 ;(#79.7) file with the most recent Dx Codes (999-1003 series implemeted with V9)
+41 ; DEFAULT DX FOR 'R' REPORT (#2.1)
+42 ; DEFAULT DX FOR 'F' REPORT (#2.2)
+43 IF $GET(^RA(78.3,999,0))="TELERADIOLOGY, NOT YET DICTATED^^N^n"
Begin DoDot:1
+44 SET RAFDA(79.7,RAHLAPP_",",2.1)=999
+45 IF $GET(^RA(78.3,1000,0))="NO ALERT REQUIRED^^N^n"
SET RAF=1
SET RAFDA(79.7,RAHLAPP_",",2.2)=1000
+46 DO FILE^DIE("","RAFDA","RAERR")
+47 IF ($DATA(RAERR("DIERR")))#2
Begin DoDot:2
+48 SET RAY=0
FOR
SET RAY=$ORDER(RAERR("DIERR",RAY))
if 'RAY
QUIT
SET RATXT(RAY)=$GET(RAERR("DIERR",RAY,"TEXT",1))
+49 QUIT
End DoDot:2
+50 IF '$TEST
Begin DoDot:2
+51 SET RATXT(1)="'TELERADIOLOGY, NOT YET DICTATED' added as the 'DEFAULT DX FOR 'R' REPORT' value."
+52 if $GET(RAF)=1
SET RATXT(2)="'NO ALERT REQUIRED' added as the 'DEFAULT DX FOR 'F' REPORT' value."
+53 QUIT
End DoDot:2
+54 DO BMES^XPDUTL(.RATXT)
+55 QUIT
End DoDot:1
+56 ;
ILOC ; assign active imaging locations to RADIOLOGY,OUTSIDE SERVICE
+1 ;
+2 NEW DIERR,RAERR,RAFDA,RAIEN,RATODAY
+3 SET (RAIEN,RAIEN(0))=$$FIND1^DIC(200,"","X","RADIOLOGY,OUTSIDE SERVICE")
SET RATODAY=$$DT^XLFDT()
+4 IF RAIEN=0!($DATA(DIERR)#2)
Begin DoDot:1
+5 DO BMES^XPDUTL("Failed NEW PERSON file lookup on: RADIOLOGY,OUTSIDE SERVICE")
QUIT
End DoDot:1
QUIT
+6 ;
+7 ;if this i-loc have been assigned to RADIOLOGY,OUTSIDE SERVICE quit (do not create duplicates)
+8 if $ORDER(^VA(200,RAIEN,"RAL",0))
QUIT
+9 ;
+10 ;find only active radiology imaging locations...
+11 NEW RAX,RAY
SET RAY=0
SET RAIEN=","_RAIEN_","
+12 FOR
SET RAY=$ORDER(^RA(79.1,RAY))
if 'RAY
QUIT
SET RAX=$GET(^(RAY,0))
Begin DoDot:1
+13 ;inactive location
IF $PIECE(RAX,U,19)
IF ($PIECE(RAX,U,19)'>RATODAY)
QUIT
+14 SET RAFDA(200.074,"+"_RAY_RAIEN,.01)=RAY
QUIT
End DoDot:1
+15 ;
+16 ;quit there is no data to file
if '($DATA(RAFDA(200.074))\10)
QUIT
+17 ;
+18 ;lock the RADIOLOGY,OUTSIDE SERVICE record in file 200, exit gracefully if locked by another
+19 LOCK +^VA(200,RAIEN(0)):$GET(DILOCKTM,3)
+20 IF '$TEST
DO BMES^XPDUTL("RADIOLOGY,OUTSIDE SERVICE is locked by another user!")
QUIT
+21 ;
+22 DO UPDATE^DIE("","RAFDA","","RAERR")
+23 IF $DATA(RAERR("DIERR"))#2
Begin DoDot:1
+24 NEW RATXT
SET RATXT(1)="Error assigning imaging locations to RADIOLOGY,OUTSIDE SERVICE."
+25 SET RATXT(2)=$GET(RAERR("DIERR","1","TEXT",1))
DO BMES^XPDUTL(.RATXT)
QUIT
End DoDot:1
+26 IF '$TEST
DO BMES^XPDUTL("Imaging locations have been assigned to RADIOLOGY,OUTSIDE SERVICE.")
+27 ;
+28 ;unlock the RADIOLOGY,OUTSIDE SERVICE record in the NEW PERSON file
+29 LOCK -^VA(200,RAIEN(0))
+30 QUIT
+31 ;
