RA45PST1 ;Hines OI/GJC - Post-init 'A', patch 45 ;10/10/03 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
;
ENQ1 ;Need to convert the data in the old 'BARIUM USED?' (#5) field in
;the 70.03 data dictionary to the CONTRAST MEDIA (#225) multiple
;70.3225. If 'Yes' to 'BARIUM USED?' then 'Barium' will be added
;as a record to the new CONTRAST MEDIA field. The 'BARIUM USED?'
;field will be deleted. This will be a background process queued
;to run by the RA*5*45 post-init.
;
;IAs used in this subroutine: 4381 ("RA" node file 101.43), 4382
;("S.XRAY" xref), & 1995 ($$cpt^icptcod)
;IA 10035 used to obtain patient name
;
;called from EN^RA45PST, queued...
K ^TMP("RA*5*45 BARIUM USED",$J)
S:$D(ZTQUEUED) ZTREQ="@" S (RACT,RADFN,ZTSTOP)=0
F S RADFN=$O(^RADPT(RADFN)) Q:'RADFN D Q:ZTSTOP
.S RADTI=0
.F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:'RADTI D Q:ZTSTOP
..S RACNI=0
..F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D Q:ZTSTOP
...S Y=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RACT=RACT+1
...S:RACT#500=0 ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
...;------------------------------------------------------------------
...;Indicate that barium was used by updating the new CONTRAST MEDIA
...;field (multiple, sub-file 70.3225)
...I $E($$UP^XLFSTR($P(Y,"^",5)))="Y" D
....;------- update fields: CONTRAST MEDIA USED & BARIUM USED? -------
....L +^RADPT(RADFN,"DT",RADTI,"P",RACNI,0):30 ;lock xam record
....I '$T D TRACK Q ;track the record that could not be updated
....S RAD3=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",$C(32)),-1)+1
....S RAIEN="+"_RAD3_","_RACNI_","_RADTI_","_RADFN_","
....S RAFDA(70.3225,RAIEN,.01)="B" D UPDATE^DIE("","RAFDA","RAIEN")
....K RAD3,RAFDA,RAIEN
....S RAIEN=RACNI_","_RADTI_","_RADFN_","
....S RAFDA(70.03,RAIEN,5)="@" ;delete data in BARIUM USED?
....S RAFDA(70.03,RAIEN,10)="Y" ;set CONTRAST MEDIA USED field to YES
....D FILE^DIE("","RAFDA") K RAFDA,RAIEN
....L -^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) ;unlock; on to next record
....Q
...;------------------------------------------------------------------
...Q
..Q
.Q
;
;delete the 'BARIUM USED?' data dictionary 70.03, field #5 only if
;the user did not stop the task
I ZTSTOP=0 K DA,DIK S DIK="^DD(70.03,",DA(1)=70.03,DA=5 D ^DIK
;
;if the user stopped the task, note that event
D:ZTSTOP=1 STOP
;
;if examination records failed to get updated, if the user terminated
;the post-init through TaskMan, or if both conditions are true inform
;the user via email
D:+$O(^TMP("RA*5*45 BARIUM USED",$J,0)) MAIL
;
KILLQ1 ;Kill and clean up symbol table
K %,DA,DIC,DIK,RACNI,RADFN,RADTI,RAIEN,X,Y
K ^TMP("RA*5*45 BARIUM USED",$J)
Q
;
MAIL ;generate the email message informing the user of the following events:
;A) some examination records were not properly updated
;B) the process was stopped by the user via TaskMan
;C) both events A & B are true
S ^TMP("RA*5*45 BARIUM USED",$J,.1)="The following patient(s) failed to have their exam records (70.03) updated"
S ^TMP("RA*5*45 BARIUM USED",$J,.2)="accordingly because another user was editing the same record."
S ^TMP("RA*5*45 BARIUM USED",$J,.3)=""
S ^TMP("RA*5*45 BARIUM USED",$J,.4)="Format: patient name ^ exam date/time ^ case # ^ procedure name (truncated to"
S ^TMP("RA*5*45 BARIUM USED",$J,.5)="forty characters)"
S ^TMP("RA*5*45 BARIUM USED",$J,.6)=""
N XMDUZ,XMSUB,XMTEXT,XMY S XMDUZ=.5
S XMTEXT="^TMP(""RA*5*45 BARIUM USED"",$J,"
S XMSUB="RA*5*45: 'Barium Used?' post-init issue detected"
I '$$GOTLOCAL^XMXAPIG("G.RAD PERFORMANCE INDICATOR") D
.S XMY(DUZ)=""
E S XMY("G.RAD PERFORMANCE INDICATOR")=""
D ^XMD
Q
;
STOP ;inform the user that the task has been stopped
S ^TMP("RA*5*45 BARIUM USED",$J,$$SUB())="RA*5*45's 'BARIUM USED?' data dictionary cleanup terminated prematurely"
Q
;
TRACK ;track the record that could not be locked for updating
;by patient name, date/time of exam, case number, & procedure
;Note: RADFN, RADTI, & RACNI are global in scope.
;
;format: pat. name^exam date/time^case #^procedure name (trunc'd to 40)
;
N RAEXAM S RAEXAM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
S ^TMP("RA*5*45 BARIUM USED",$J,$$SUB())=$$GET1^DIQ(2,RADFN,.01)_U_$$FMTE^XLFDT((9999999.9999-RADTI),"1P")_U_$P(RAEXAM,U)_U_$E($$GET1^DIQ(71,+$P(RAEXAM,U,2),.01),1,40)
Q
;
SUB() ;return the next available subscript (arithmetic progression)
Q +$O(^TMP("RA*5*45 BARIUM USED",$J,$C(32)),-1)+1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA45PST1 4542 printed Sep 23, 2025@20:09:21 Page 2
RA45PST1 ;Hines OI/GJC - Post-init 'A', patch 45 ;10/10/03 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
+1 ;
ENQ1 ;Need to convert the data in the old 'BARIUM USED?' (#5) field in
+1 ;the 70.03 data dictionary to the CONTRAST MEDIA (#225) multiple
+2 ;70.3225. If 'Yes' to 'BARIUM USED?' then 'Barium' will be added
+3 ;as a record to the new CONTRAST MEDIA field. The 'BARIUM USED?'
+4 ;field will be deleted. This will be a background process queued
+5 ;to run by the RA*5*45 post-init.
+6 ;
+7 ;IAs used in this subroutine: 4381 ("RA" node file 101.43), 4382
+8 ;("S.XRAY" xref), & 1995 ($$cpt^icptcod)
+9 ;IA 10035 used to obtain patient name
+10 ;
+11 ;called from EN^RA45PST, queued...
+12 KILL ^TMP("RA*5*45 BARIUM USED",$JOB)
+13 if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET (RACT,RADFN,ZTSTOP)=0
+14 FOR
SET RADFN=$ORDER(^RADPT(RADFN))
if 'RADFN
QUIT
Begin DoDot:1
+15 SET RADTI=0
+16 FOR
SET RADTI=$ORDER(^RADPT(RADFN,"DT",RADTI))
if 'RADTI
QUIT
Begin DoDot:2
+17 SET RACNI=0
+18 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if 'RACNI
QUIT
Begin DoDot:3
+19 SET Y=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
SET RACT=RACT+1
+20 if RACT#500=0
SET ZTSTOP=$$S^%ZTLOAD()
if ZTSTOP
QUIT
+21 ;------------------------------------------------------------------
+22 ;Indicate that barium was used by updating the new CONTRAST MEDIA
+23 ;field (multiple, sub-file 70.3225)
+24 IF $EXTRACT($$UP^XLFSTR($PIECE(Y,"^",5)))="Y"
Begin DoDot:4
+25 ;------- update fields: CONTRAST MEDIA USED & BARIUM USED? -------
+26 ;lock xam record
LOCK +^RADPT(RADFN,"DT",RADTI,"P",RACNI,0):30
+27 ;track the record that could not be updated
IF '$TEST
DO TRACK
QUIT
+28 SET RAD3=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",$CHAR(32)),-1)+1
+29 SET RAIEN="+"_RAD3_","_RACNI_","_RADTI_","_RADFN_","
+30 SET RAFDA(70.3225,RAIEN,.01)="B"
DO UPDATE^DIE("","RAFDA","RAIEN")
+31 KILL RAD3,RAFDA,RAIEN
+32 SET RAIEN=RACNI_","_RADTI_","_RADFN_","
+33 ;delete data in BARIUM USED?
SET RAFDA(70.03,RAIEN,5)="@"
+34 ;set CONTRAST MEDIA USED field to YES
SET RAFDA(70.03,RAIEN,10)="Y"
+35 DO FILE^DIE("","RAFDA")
KILL RAFDA,RAIEN
+36 ;unlock; on to next record
LOCK -^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
+37 QUIT
End DoDot:4
+38 ;------------------------------------------------------------------
+39 QUIT
End DoDot:3
if ZTSTOP
QUIT
+40 QUIT
End DoDot:2
if ZTSTOP
QUIT
+41 QUIT
End DoDot:1
if ZTSTOP
QUIT
+42 ;
+43 ;delete the 'BARIUM USED?' data dictionary 70.03, field #5 only if
+44 ;the user did not stop the task
+45 IF ZTSTOP=0
KILL DA,DIK
SET DIK="^DD(70.03,"
SET DA(1)=70.03
SET DA=5
DO ^DIK
+46 ;
+47 ;if the user stopped the task, note that event
+48 if ZTSTOP=1
DO STOP
+49 ;
+50 ;if examination records failed to get updated, if the user terminated
+51 ;the post-init through TaskMan, or if both conditions are true inform
+52 ;the user via email
+53 if +$ORDER(^TMP("RA*5*45 BARIUM USED",$JOB,0))
DO MAIL
+54 ;
KILLQ1 ;Kill and clean up symbol table
+1 KILL %,DA,DIC,DIK,RACNI,RADFN,RADTI,RAIEN,X,Y
+2 KILL ^TMP("RA*5*45 BARIUM USED",$JOB)
+3 QUIT
+4 ;
MAIL ;generate the email message informing the user of the following events:
+1 ;A) some examination records were not properly updated
+2 ;B) the process was stopped by the user via TaskMan
+3 ;C) both events A & B are true
+4 SET ^TMP("RA*5*45 BARIUM USED",$JOB,.1)="The following patient(s) failed to have their exam records (70.03) updated"
+5 SET ^TMP("RA*5*45 BARIUM USED",$JOB,.2)="accordingly because another user was editing the same record."
+6 SET ^TMP("RA*5*45 BARIUM USED",$JOB,.3)=""
+7 SET ^TMP("RA*5*45 BARIUM USED",$JOB,.4)="Format: patient name ^ exam date/time ^ case # ^ procedure name (truncated to"
+8 SET ^TMP("RA*5*45 BARIUM USED",$JOB,.5)="forty characters)"
+9 SET ^TMP("RA*5*45 BARIUM USED",$JOB,.6)=""
+10 NEW XMDUZ,XMSUB,XMTEXT,XMY
SET XMDUZ=.5
+11 SET XMTEXT="^TMP(""RA*5*45 BARIUM USED"",$J,"
+12 SET XMSUB="RA*5*45: 'Barium Used?' post-init issue detected"
+13 IF '$$GOTLOCAL^XMXAPIG("G.RAD PERFORMANCE INDICATOR")
Begin DoDot:1
+14 SET XMY(DUZ)=""
End DoDot:1
+15 IF '$TEST
SET XMY("G.RAD PERFORMANCE INDICATOR")=""
+16 DO ^XMD
+17 QUIT
+18 ;
STOP ;inform the user that the task has been stopped
+1 SET ^TMP("RA*5*45 BARIUM USED",$JOB,$$SUB())="RA*5*45's 'BARIUM USED?' data dictionary cleanup terminated prematurely"
+2 QUIT
+3 ;
TRACK ;track the record that could not be locked for updating
+1 ;by patient name, date/time of exam, case number, & procedure
+2 ;Note: RADFN, RADTI, & RACNI are global in scope.
+3 ;
+4 ;format: pat. name^exam date/time^case #^procedure name (trunc'd to 40)
+5 ;
+6 NEW RAEXAM
SET RAEXAM=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+7 SET ^TMP("RA*5*45 BARIUM USED",$JOB,$$SUB())=$$GET1^DIQ(2,RADFN,.01)_U_$$FMTE^XLFDT((9999999.9999-RADTI),"1P")_U_$PIECE(RAEXAM,U)_U_$EXTRACT($$GET1^DIQ(71,+$PIECE(RAEXAM,U,2),.01),1,40)
+8 QUIT
+9 ;
SUB() ;return the next available subscript (arithmetic progression)
+1 QUIT +$ORDER(^TMP("RA*5*45 BARIUM USED",$JOB,$CHAR(32)),-1)+1
+2 ;
