RA45PST ;Hines OI/GJC - Post-init Driver, patch 45 ;10/10/03 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
;
EN ;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.
I '$D(^DD(70.03,5,0))#2 D
.S RATXT(1)="'BARIUM USED?' (sub-dd: 70.03, fld: 5) field has been deleted in the"
.S RATXT(2)="past; no further action taken regarding this data dictionary."
.D MES^XPDUTL(.RATXT) K RATXT
.Q
E D
.N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
.S ZTIO="",ZTRTN="ENQ1^RA45PST1"
.S ZTDESC="RA*5.0*45: 'BARIUM USED?' (dd: 70.03;fld: 5) field cleanup"
.S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0) ;add 2 minutes to 'now'
.D ^%ZTLOAD S RATXT(1)=" "
.S RATXT(2)="RA*5.0*45: delete 'BARIUM USED?' field, convert data to CONTRAST MEDIA (70.3225) multiple"
.S:$G(ZTSK)>0 RATXT(3)="Task: "_ZTSK_"."
.S RATXT(4)=" " D MES^XPDUTL(.RATXT)
.Q
;
SEED71 ;The second process must be tasked off that will identify all the
;Rad/Nuc Med orderable items (OI) in file 101.43 checking them to
;see if barium, oral cholecystogram or unspecified contrast media
;happen to be associated contrasts.
;
;If no associations move onto the next OI and check for CMs
;
;If yes, update the procedure in file 71; add barium, oral
;cholecystografic or unspecified contrast media to the CONTRAST MEDIA
;(#125) multiple in file 71. All successful and unsuccessful updates
;will be presented to the user in the form of an email message.
;(Failure to update occurs when a record cannot be locked)
;
;Finally, the Rad/Nuc Med Procedure (71) file will be synchronized with
;the Orderable Items (101.43) file.
;
N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
S ZTIO="",ZTRTN="ENQ2^RA45PST2"
S ZTDESC="RA*5.0*45: seed new CONTRAST MEDIA (#125) field in file 71"
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0) ;add 2 minutes to 'now'
D ^%ZTLOAD S RATXT(1)=" "
S RATXT(2)="RA*5.0*45: seed new CONTRAST MEDIA (#125) field in file 71"
S:$G(ZTSK)>0 RATXT(3)="Task: "_ZTSK_"."
S RATXT(4)=" " D MES^XPDUTL(.RATXT)
Q
;
MAILQ2(FORMAT,SUBJECT) ;Update users via email; let the user(s) know which
;Rad/NM Procedures have been updated according to their Orderable Item
;equivalents.
;input: FORMAT='1' for Orderable Item CM definitions applied to Rad/Nuc
; Med procedure, '2' for sychronization between Rad/Nuc Med
; Procedure and the Orderable Items file (Rad/Nuc Med
; function)
; SUBJECT=subject of the email
;
Q:FORMAT'=1&(FORMAT'=2) Q:$G(SUBJECT)="" NEW RAX
S:FORMAT=1 $P(RAX," ",81)="",$E(RAX,1,6)="Status",$E(RAX,10,18)="Procedure",$E(RAX,52,55)="CPT",$E(RAX,60,67)="Contrast"
S:FORMAT=2 $P(RAX," ",81)="",$E(RAX,1,6)="Status",$E(RAX,10,18)="Procedure",$E(RAX,55,58)="CPT",$E(RAX,65,72)="Contrast"
S ^TMP("RA PROC UPDATE 45",$J,.3)=RAX
S $P(^TMP("RA PROC UPDATE 45",$J,.6),"-",81)="" ;80 dashes
N XMDUZ,XMSUB,XMTEXT,XMY S XMDUZ=.5
S XMTEXT="^TMP(""RA PROC UPDATE 45"",$J,",XMSUB=SUBJECT
I '$$GOTLOCAL^XMXAPIG("G.RAD PERFORMANCE INDICATOR") D
.S XMY(DUZ)=""
E S XMY("G.RAD PERFORMANCE INDICATOR")=""
D ^XMD
Q
;
RA45PST ;Hines OI/GJC - Post-init Driver, patch 45 ;10/10/03 06:32
VERSION ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
+1 ;
EN ;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 IF '$DATA(^DD(70.03,5,0))#2
Begin DoDot:1
+7 SET RATXT(1)="'BARIUM USED?' (sub-dd: 70.03, fld: 5) field has been deleted in the"
+8 SET RATXT(2)="past; no further action taken regarding this data dictionary."
+9 DO MES^XPDUTL(.RATXT)
KILL RATXT
+10 QUIT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
+13 SET ZTIO=""
SET ZTRTN="ENQ1^RA45PST1"
+14 SET ZTDESC="RA*5.0*45: 'BARIUM USED?' (dd: 70.03;fld: 5) field cleanup"
+15 ;add 2 minutes to 'now'
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0)
+16 DO ^%ZTLOAD
SET RATXT(1)=" "
+17 SET RATXT(2)="RA*5.0*45: delete 'BARIUM USED?' field, convert data to CONTRAST MEDIA (70.3225) multiple"
+18 IF $GET(ZTSK)>0
SET RATXT(3)="Task: "_ZTSK_"."
+19 SET RATXT(4)=" "
DO MES^XPDUTL(.RATXT)
+20 QUIT
End DoDot:1
+21 ;
SEED71 ;The second process must be tasked off that will identify all the
+1 ;Rad/Nuc Med orderable items (OI) in file 101.43 checking them to
+2 ;see if barium, oral cholecystogram or unspecified contrast media
+3 ;happen to be associated contrasts.
+4 ;
+5 ;If no associations move onto the next OI and check for CMs
+6 ;
+7 ;If yes, update the procedure in file 71; add barium, oral
+8 ;cholecystografic or unspecified contrast media to the CONTRAST MEDIA
+9 ;(#125) multiple in file 71. All successful and unsuccessful updates
+10 ;will be presented to the user in the form of an email message.
+11 ;(Failure to update occurs when a record cannot be locked)
+12 ;
+13 ;Finally, the Rad/Nuc Med Procedure (71) file will be synchronized with
+14 ;the Orderable Items (101.43) file.
+15 ;
+16 NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN
+17 SET ZTIO=""
SET ZTRTN="ENQ2^RA45PST2"
+18 SET ZTDESC="RA*5.0*45: seed new CONTRAST MEDIA (#125) field in file 71"
+19 ;add 2 minutes to 'now'
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,2,0)
+20 DO ^%ZTLOAD
SET RATXT(1)=" "
+21 SET RATXT(2)="RA*5.0*45: seed new CONTRAST MEDIA (#125) field in file 71"
+22 IF $GET(ZTSK)>0
SET RATXT(3)="Task: "_ZTSK_"."
+23 SET RATXT(4)=" "
DO MES^XPDUTL(.RATXT)
+24 QUIT
+25 ;
MAILQ2(FORMAT,SUBJECT) ;Update users via email; let the user(s) know which
+1 ;Rad/NM Procedures have been updated according to their Orderable Item
+2 ;equivalents.
+3 ;input: FORMAT='1' for Orderable Item CM definitions applied to Rad/Nuc
+4 ; Med procedure, '2' for sychronization between Rad/Nuc Med
+5 ; Procedure and the Orderable Items file (Rad/Nuc Med
+6 ; function)
+7 ; SUBJECT=subject of the email
+8 ;
+9 IF FORMAT'=1&(FORMAT'=2)
QUIT
IF $GET(SUBJECT)=""
QUIT
NEW RAX
+10 IF FORMAT=1
SET $PIECE(RAX," ",81)=""
SET $EXTRACT(RAX,1,6)="Status"
SET $EXTRACT(RAX,10,18)="Procedure"
SET $EXTRACT(RAX,52,55)="CPT"
SET $EXTRACT(RAX,60,67)="Contrast"
+11 IF FORMAT=2
SET $PIECE(RAX," ",81)=""
SET $EXTRACT(RAX,1,6)="Status"
SET $EXTRACT(RAX,10,18)="Procedure"
SET $EXTRACT(RAX,55,58)="CPT"
SET $EXTRACT(RAX,65,72)="Contrast"
+12 SET ^TMP("RA PROC UPDATE 45",$JOB,.3)=RAX
+13 ;80 dashes
SET $PIECE(^TMP("RA PROC UPDATE 45",$JOB,.6),"-",81)=""
+14 NEW XMDUZ,XMSUB,XMTEXT,XMY
SET XMDUZ=.5
+15 SET XMTEXT="^TMP(""RA PROC UPDATE 45"",$J,"
SET XMSUB=SUBJECT
+16 IF '$$GOTLOCAL^XMXAPIG("G.RAD PERFORMANCE INDICATOR")
Begin DoDot:1
+17 SET XMY(DUZ)=""
End DoDot:1
+18 IF '$TEST
SET XMY("G.RAD PERFORMANCE INDICATOR")=""
+19 DO ^XMD
+20 QUIT
+21 ;
