RA94PST ;Hines OI/GJC - Post-init Driver, patch 94 ;07/24/08 12:13
;;5.0;Radiology/Nuclear Medicine;**94**;Mar 16, 1998;Build 9
;
NEW1AD ;Check to see if the traditional "AD" cross-reference was deleted.
;If not, delete the traditional "AD" cross-reference. Check to see if
;the new style "AD" cross-reference exists. If it does, delete it and
;re-create it while re-indexing the data. If the new style "AD" does not
;exist, create it while re-indexing the data.
;
;Tag^Routine Integration Agreement
;------------------------------------------------
;^%ZTLOAD 10063
;CREIXN/DELIX/DELIXN^DDMOD 2916
;$$FIND1^DIC 2051
;$$GET1^DIQ(2056)
;$$FMADD/$$NOW^XLFDT 10103
;^XMD 10070
;$$GOTLOCAL^XMXAPIG 3006
;MES^XPDUTL 10141
;$$KSP^XUPARAM(2541)
;
N DIERR,RAERR,RANODE,RATXT,RAVALUE,RAXIT,RAY
;
;In order to create the new style "AD" cross-reference & re-index the data
;the traditional "AD" cross-reference has to be deleted.
;
; -----------------------------------------------------------
;| Deleting of the "AD" cross-reference from '^DD(70.03,13,' |
;| will also cause the "AD" cross-reference to be deleted. |
; -----------------------------------------------------------
;
;^DD(70.03,13,1,n,0)=definition ex: 70^AD^MUMPS
;^DD(70.03,13,1,n,1)=set logic
;^DD(70.03,13,1,n,2)=kill logic
;^DD(70.03,13,1,n,3)=no-deletion message
;^DD(70.03,13,1,n,"%D",x,0)=description of cross-reference
;Where 'n' is the cross-reference instance
;Where 'x' is the description line instance
;
S RANODE=$NA(^DD(70.03,13,1)),(RAXIT,RAY)=0
F S RAY=$O(@RANODE@(RAY)) Q:'RAY Q:$G(@RANODE@(RAY,0))="70^AD^MUMPS"
;
I RAY>0 D ;there is a traditional "AD" cross-reference to delete
.D DELIX^DDMOD(70.03,13,RAY,"K","","RAERR") ;"K" delete the cross-referenced data
.I $D(RAERR("DIERR"))#2 S RAXIT=1 D
..S RATXT(1)="Error when attempting to delete the traditional ""AD"" cross-reference."
..S RATXT(2)="Field name: PRIMARY DIAGNOSTIC CODE, data dictionary: 70.03, field #: 13" Q
.E S RATXT(1)="The traditional ""AD"" cross-reference has been deleted."
.S RATXT($O(RATXT($C(32)),-1)+1)="" D MES^XPDUTL(.RATXT) Q
;
;<<< If there was a traditional "AD" cross-reference to delete was it deleted (RAXIT=0)? >>>
;
I RAXIT K RATXT D Q ;cannot continue until the old "AD" is deleted
.S RATXT(1)="The new style ""AD"" cross-reference cannot be created until"
.S RATXT(2)="the traditional ""AD"" cross-reference is deleted."
.D MES^XPDUTL(.RATXT) Q
;
; ------------------------------------------------------------
;| Check to see if the new style "AD" cross-reference exists. |
;| If it does delete the new style "AD" cross-reference. |
;| |
;| Then re-create the new style "AD" cross-reference while |
;| cross-referencing the data.
; ------------------------------------------------------------
;
S RAVALUE(1)=70,RAVALUE(2)="AD"
;Note: "BB" (5th subscript) is the FILE & NAME cross-reference index in the INDEX (#.11) file.
;he third subscript "X"
S RAY=$$FIND1^DIC(.11,"","X",.RAVALUE,"BB","","RAERR")
;
I RAY K RATXT D ;found a match
.S RATXT(1)="The 'New Style' PRIMARY DIAGNOSTIC CODE (70.03, #13) ""AD"""
.S RATXT(2)="is currently in existence. We will rebuild and re-index the"
.S RATXT(3)="""AD"" cross-reference.",RATXT($O(RATXT($C(32)),-1)+1)=""
.D MES^XPDUTL(.RATXT)
.D DELIXN^DDMOD(70.03,"AD","K") ;delete the prior instance and the data indexed
.Q
;
;-----------------------------------------------------
;
I RAY="" K RATXT D Q ;error on lookup
.S RATXT=$G(RAERR("DIERR","1","TEXT",1))
.S RATXT(1)="Error determining if the new style PRIMARY DIAGNOSTIC CODE (70.03, #13) ""AD"""
.S RATXT(2)="cross-reference exists. This error prohibits us from moving forward."
.S:$G(RAERR("DIERR","1","TEXT",1))'="" RATXT(3)=$G(RAERR("DIERR","1","TEXT",1))
.D MES^XPDUTL(.RATXT) Q
;
;-----------------------------------------------------
;
;There are two possible realities at this point. One is that the new style "AD"
;cross-reference did exist (RAY>0) in which case we proceeded to delete that
;instance of the new style "AD" and now move to rebuilt and re-index the index.
;
;Or, the new style "AD" cross-reference never did exist (RAY=0). In this case, we
;create the new style "AD" cross-reference and rebuild the "AD" cross-reference.
;
;In either case, due to the length of time to re-index, the process is tasked off
;
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK S ZTRTN="CREIXN^RA94PST",ZTIO=""
S ZTDTH=$$FMADD^XLFDT($E($$NOW^XLFDT(),1,12),0,0,1,0) ;start task in one minute...
S ZTDESC="RA94PST, the post-install process for RA*5.0*94, rebuilds the ""AD"" xref on the PRIMARY DIAGNOSTIC CODE (70.03 - 0;13) field."
D ^%ZTLOAD K RATXT S RATXT(1)=""
I $D(ZTSK)#2[0 S RATXT(2)="Task Cancelled"
E S RATXT(2)="Task: "_$G(ZTSK)_" queued..."
D MES^XPDUTL(.RATXT) Q
;
;
CREIXN ;rebuilds the ""AD"" xref on the PRIMARY DIAGNOSTIC CODE (70.03 - 0;13) field
;Note: this is a background process created by ^%ZTLOAD.
N RARSLT,RAXREF K DIERR,RAERR,RATXT
S RAXREF("FILE")=70,RAXREF("TYPE")="MU",RAXREF("NAME")="AD"
S RAXREF("EXECUTION")="F",RAXREF("ROOT FILE")=70.03,RAXREF("USE")="S"
S RAXREF("ACTIVITY")="IR"
S RAXREF("SHORT DESCR")="The 'AD' is used to mark cases eligible for the Abnormal Report option."
S RAXREF("DESCR",1)="If the diagnostic code record in the radiology DIAGNOSTIC CODES (#78.3)"
S RAXREF("DESCR",2)="has the data attribute for field: PRINT ON ABNORMAL REPORT (#3) set to"
S RAXREF("DESCR",3)="'Y' (yes) then the ""AD"" cross-reference will be set for this exam record"
S RAXREF("DESCR",4)="to indicate that this case should be identified on the Abnormal Report."
S RAXREF("DESCR",5)=""
S RAXREF("DESCR",6)="NOTE: When this field is edited the DIAGNOSTIC PRINT DATE (#20) field is"
S RAXREF("DESCR",7)="deleted!",RAXREF("VAL",1)=13
S RAXREF("KILL CONDITION")="S:X1(1)'="""" X=1"
S RAXREF("KILL")="D:($D(X1(1))#2) PRIDXIXK^RADD2(.DA,X1(1))"
S RAXREF("SET CONDITION")="S:X2(1)'="""" X=1"
S RAXREF("SET")="S:$P($G(^RA(78.3,X2(1),0)),U,3)=""Y"" ^RADPT(""AD"",X2(1),DA(2),DA(1),DA)="""""
;S RAXREF("WHOLE KILL")="K ^RADPT(""AD"")" Note: no re-indexing is to occur.
;
;D CREIXN^DDMOD(.RAXREF,"S",.RARSLT,"","RAERR") ;"S" (2nd parameter) means the "AD" is rebuilt
D CREIXN^DDMOD(.RAXREF,"",.RARSLT,"","RAERR") ;the 2nd input param is null; no re-indexing
;
BLDMSG ;failure: we did not create the cross-reference
I RARSLT=""!($D(RAERR("DIERR"))#2) D
.S RATXT(1)="Facility: "_$$GET1^DIQ(4,+$$KSP^XUPARAM("INST"),.01),RATXT(2)=""
.S RATXT(3)="Error when attempting to delete the new style ""AD"" cross-reference."
.S RATXT(4)="Field name: PRIMARY DIAGNOSTIC CODE, data dictionary: 70.03, field #: 13"
.S RATXT(5)=$G(RAERR("DIERR",1,"TEXT",1))
.N RAIRM S RAIRM="Contact your local IRM support staff."
.I RATXT(5)="" S RATXT(6)=RAIRM
.E S RATXT(6)="",RATXT(7)=RAIRM
.Q
;
E S ZTREQ="@"
;
Q:'$O(RATXT(0)) ;no news is good news...
;
MAIL ; pass the negative results concerning the tasked process
;(rebuilding the "AD" xref) to the user via VA MailMan
N %,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY
S XMDUZ=.5,XMTEXT="RATXT("
S XMSUB="RA*5.0*94: results of rebuilding the ""AD"" cross-reference"
I '$$GOTLOCAL^XMXAPIG("G.RAD HL7 MESSAGES") D
.S XMY(DUZ)=""
E S XMY("G.RAD HL7 MESSAGES")=""
S XMY("VAOITVHITRadDevIssues@domain.ext")="" ;to me...
D ^XMD Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA94PST 7787 printed Mar 13, 2025@21:38:21 Page 2
RA94PST ;Hines OI/GJC - Post-init Driver, patch 94 ;07/24/08 12:13
+1 ;;5.0;Radiology/Nuclear Medicine;**94**;Mar 16, 1998;Build 9
+2 ;
NEW1AD ;Check to see if the traditional "AD" cross-reference was deleted.
+1 ;If not, delete the traditional "AD" cross-reference. Check to see if
+2 ;the new style "AD" cross-reference exists. If it does, delete it and
+3 ;re-create it while re-indexing the data. If the new style "AD" does not
+4 ;exist, create it while re-indexing the data.
+5 ;
+6 ;Tag^Routine Integration Agreement
+7 ;------------------------------------------------
+8 ;^%ZTLOAD 10063
+9 ;CREIXN/DELIX/DELIXN^DDMOD 2916
+10 ;$$FIND1^DIC 2051
+11 ;$$GET1^DIQ(2056)
+12 ;$$FMADD/$$NOW^XLFDT 10103
+13 ;^XMD 10070
+14 ;$$GOTLOCAL^XMXAPIG 3006
+15 ;MES^XPDUTL 10141
+16 ;$$KSP^XUPARAM(2541)
+17 ;
+18 NEW DIERR,RAERR,RANODE,RATXT,RAVALUE,RAXIT,RAY
+19 ;
+20 ;In order to create the new style "AD" cross-reference & re-index the data
+21 ;the traditional "AD" cross-reference has to be deleted.
+22 ;
+23 ; -----------------------------------------------------------
+24 ;| Deleting of the "AD" cross-reference from '^DD(70.03,13,' |
+25 ;| will also cause the "AD" cross-reference to be deleted. |
+26 ; -----------------------------------------------------------
+27 ;
+28 ;^DD(70.03,13,1,n,0)=definition ex: 70^AD^MUMPS
+29 ;^DD(70.03,13,1,n,1)=set logic
+30 ;^DD(70.03,13,1,n,2)=kill logic
+31 ;^DD(70.03,13,1,n,3)=no-deletion message
+32 ;^DD(70.03,13,1,n,"%D",x,0)=description of cross-reference
+33 ;Where 'n' is the cross-reference instance
+34 ;Where 'x' is the description line instance
+35 ;
+36 SET RANODE=$NAME(^DD(70.03,13,1))
SET (RAXIT,RAY)=0
+37 FOR
SET RAY=$ORDER(@RANODE@(RAY))
if 'RAY
QUIT
if $GET(@RANODE@(RAY,0))="70^AD^MUMPS"
QUIT
+38 ;
+39 ;there is a traditional "AD" cross-reference to delete
IF RAY>0
Begin DoDot:1
+40 ;"K" delete the cross-referenced data
DO DELIX^DDMOD(70.03,13,RAY,"K","","RAERR")
+41 IF $DATA(RAERR("DIERR"))#2
SET RAXIT=1
Begin DoDot:2
+42 SET RATXT(1)="Error when attempting to delete the traditional ""AD"" cross-reference."
+43 SET RATXT(2)="Field name: PRIMARY DIAGNOSTIC CODE, data dictionary: 70.03, field #: 13"
QUIT
End DoDot:2
+44 IF '$TEST
SET RATXT(1)="The traditional ""AD"" cross-reference has been deleted."
+45 SET RATXT($ORDER(RATXT($CHAR(32)),-1)+1)=""
DO MES^XPDUTL(.RATXT)
QUIT
End DoDot:1
+46 ;
+47 ;<<< If there was a traditional "AD" cross-reference to delete was it deleted (RAXIT=0)? >>>
+48 ;
+49 ;cannot continue until the old "AD" is deleted
IF RAXIT
KILL RATXT
Begin DoDot:1
+50 SET RATXT(1)="The new style ""AD"" cross-reference cannot be created until"
+51 SET RATXT(2)="the traditional ""AD"" cross-reference is deleted."
+52 DO MES^XPDUTL(.RATXT)
QUIT
End DoDot:1
QUIT
+53 ;
+54 ; ------------------------------------------------------------
+55 ;| Check to see if the new style "AD" cross-reference exists. |
+56 ;| If it does delete the new style "AD" cross-reference. |
+57 ;| |
+58 ;| Then re-create the new style "AD" cross-reference while |
+59 ;| cross-referencing the data.
+60 ; ------------------------------------------------------------
+61 ;
+62 SET RAVALUE(1)=70
SET RAVALUE(2)="AD"
+63 ;Note: "BB" (5th subscript) is the FILE & NAME cross-reference index in the INDEX (#.11) file.
+64 ;he third subscript "X"
+65 SET RAY=$$FIND1^DIC(.11,"","X",.RAVALUE,"BB","","RAERR")
+66 ;
+67 ;found a match
IF RAY
KILL RATXT
Begin DoDot:1
+68 SET RATXT(1)="The 'New Style' PRIMARY DIAGNOSTIC CODE (70.03, #13) ""AD"""
+69 SET RATXT(2)="is currently in existence. We will rebuild and re-index the"
+70 SET RATXT(3)="""AD"" cross-reference."
SET RATXT($ORDER(RATXT($CHAR(32)),-1)+1)=""
+71 DO MES^XPDUTL(.RATXT)
+72 ;delete the prior instance and the data indexed
DO DELIXN^DDMOD(70.03,"AD","K")
+73 QUIT
End DoDot:1
+74 ;
+75 ;-----------------------------------------------------
+76 ;
+77 ;error on lookup
IF RAY=""
KILL RATXT
Begin DoDot:1
+78 SET RATXT=$GET(RAERR("DIERR","1","TEXT",1))
+79 SET RATXT(1)="Error determining if the new style PRIMARY DIAGNOSTIC CODE (70.03, #13) ""AD"""
+80 SET RATXT(2)="cross-reference exists. This error prohibits us from moving forward."
+81 if $GET(RAERR("DIERR","1","TEXT",1))'=""
SET RATXT(3)=$GET(RAERR("DIERR","1","TEXT",1))
+82 DO MES^XPDUTL(.RATXT)
QUIT
End DoDot:1
QUIT
+83 ;
+84 ;-----------------------------------------------------
+85 ;
+86 ;There are two possible realities at this point. One is that the new style "AD"
+87 ;cross-reference did exist (RAY>0) in which case we proceeded to delete that
+88 ;instance of the new style "AD" and now move to rebuilt and re-index the index.
+89 ;
+90 ;Or, the new style "AD" cross-reference never did exist (RAY=0). In this case, we
+91 ;create the new style "AD" cross-reference and rebuild the "AD" cross-reference.
+92 ;
+93 ;In either case, due to the length of time to re-index, the process is tasked off
+94 ;
+95 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
SET ZTRTN="CREIXN^RA94PST"
SET ZTIO=""
+96 ;start task in one minute...
SET ZTDTH=$$FMADD^XLFDT($EXTRACT($$NOW^XLFDT(),1,12),0,0,1,0)
+97 SET ZTDESC="RA94PST, the post-install process for RA*5.0*94, rebuilds the ""AD"" xref on the PRIMARY DIAGNOSTIC CODE (70.03 - 0;13) field."
+98 DO ^%ZTLOAD
KILL RATXT
SET RATXT(1)=""
+99 IF $DATA(ZTSK)#2[0
SET RATXT(2)="Task Cancelled"
+100 IF '$TEST
SET RATXT(2)="Task: "_$GET(ZTSK)_" queued..."
+101 DO MES^XPDUTL(.RATXT)
QUIT
+102 ;
+103 ;
CREIXN ;rebuilds the ""AD"" xref on the PRIMARY DIAGNOSTIC CODE (70.03 - 0;13) field
+1 ;Note: this is a background process created by ^%ZTLOAD.
+2 NEW RARSLT,RAXREF
KILL DIERR,RAERR,RATXT
+3 SET RAXREF("FILE")=70
SET RAXREF("TYPE")="MU"
SET RAXREF("NAME")="AD"
+4 SET RAXREF("EXECUTION")="F"
SET RAXREF("ROOT FILE")=70.03
SET RAXREF("USE")="S"
+5 SET RAXREF("ACTIVITY")="IR"
+6 SET RAXREF("SHORT DESCR")="The 'AD' is used to mark cases eligible for the Abnormal Report option."
+7 SET RAXREF("DESCR",1)="If the diagnostic code record in the radiology DIAGNOSTIC CODES (#78.3)"
+8 SET RAXREF("DESCR",2)="has the data attribute for field: PRINT ON ABNORMAL REPORT (#3) set to"
+9 SET RAXREF("DESCR",3)="'Y' (yes) then the ""AD"" cross-reference will be set for this exam record"
+10 SET RAXREF("DESCR",4)="to indicate that this case should be identified on the Abnormal Report."
+11 SET RAXREF("DESCR",5)=""
+12 SET RAXREF("DESCR",6)="NOTE: When this field is edited the DIAGNOSTIC PRINT DATE (#20) field is"
+13 SET RAXREF("DESCR",7)="deleted!"
SET RAXREF("VAL",1)=13
+14 SET RAXREF("KILL CONDITION")="S:X1(1)'="""" X=1"
+15 SET RAXREF("KILL")="D:($D(X1(1))#2) PRIDXIXK^RADD2(.DA,X1(1))"
+16 SET RAXREF("SET CONDITION")="S:X2(1)'="""" X=1"
+17 SET RAXREF("SET")="S:$P($G(^RA(78.3,X2(1),0)),U,3)=""Y"" ^RADPT(""AD"",X2(1),DA(2),DA(1),DA)="""""
+18 ;S RAXREF("WHOLE KILL")="K ^RADPT(""AD"")" Note: no re-indexing is to occur.
+19 ;
+20 ;D CREIXN^DDMOD(.RAXREF,"S",.RARSLT,"","RAERR") ;"S" (2nd parameter) means the "AD" is rebuilt
+21 ;the 2nd input param is null; no re-indexing
DO CREIXN^DDMOD(.RAXREF,"",.RARSLT,"","RAERR")
+22 ;
BLDMSG ;failure: we did not create the cross-reference
+1 IF RARSLT=""!($DATA(RAERR("DIERR"))#2)
Begin DoDot:1
+2 SET RATXT(1)="Facility: "_$$GET1^DIQ(4,+$$KSP^XUPARAM("INST"),.01)
SET RATXT(2)=""
+3 SET RATXT(3)="Error when attempting to delete the new style ""AD"" cross-reference."
+4 SET RATXT(4)="Field name: PRIMARY DIAGNOSTIC CODE, data dictionary: 70.03, field #: 13"
+5 SET RATXT(5)=$GET(RAERR("DIERR",1,"TEXT",1))
+6 NEW RAIRM
SET RAIRM="Contact your local IRM support staff."
+7 IF RATXT(5)=""
SET RATXT(6)=RAIRM
+8 IF '$TEST
SET RATXT(6)=""
SET RATXT(7)=RAIRM
+9 QUIT
End DoDot:1
+10 ;
+11 IF '$TEST
SET ZTREQ="@"
+12 ;
+13 ;no news is good news...
if '$ORDER(RATXT(0))
QUIT
+14 ;
MAIL ; pass the negative results concerning the tasked process
+1 ;(rebuilding the "AD" xref) to the user via VA MailMan
+2 NEW %,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY
+3 SET XMDUZ=.5
SET XMTEXT="RATXT("
+4 SET XMSUB="RA*5.0*94: results of rebuilding the ""AD"" cross-reference"
+5 IF '$$GOTLOCAL^XMXAPIG("G.RAD HL7 MESSAGES")
Begin DoDot:1
+6 SET XMY(DUZ)=""
End DoDot:1
+7 IF '$TEST
SET XMY("G.RAD HL7 MESSAGES")=""
+8 ;to me...
SET XMY("VAOITVHITRadDevIssues@domain.ext")=""
+9 DO ^XMD
QUIT
+10 ;
