RAIPST4 ;HIRMFO/GJC - Post-init number four ;12/18/97 09:08
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
;
EN1 ; Add Exam Statuses with an Imaging Type of 'Mammography'.
; Exam Statuses created: Cancelled; Waiting For Exam; Called
; For Exam; Examined; Transcribed and Complete.
N RAERR,RAFDA,RAITY,RATXT S RATXT(1)=" "
S RAITY=+$O(^RA(79.2,"B","MAMMOGRAPHY",0))
I RAITY=0 D Q ; mammography missing as an i-type
. S RATXT(1)=" ",RATXT(2)="Error, 'MAMMOGRAPHY' missing from the Imaging Type (79.2) file.",RATXT(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
. D MES^XPDUTL(.RATXT)
. Q
S RATXT(1)=" "
S RATXT(2)="Add Exam Statuses with an Imaging Type of 'Mammography'."
S RATXT(3)="Exam Statuses created: Cancelled; Waiting For Exam; Called"
S RATXT(4)="For Exam; Examined; Transcribed and Complete."
D MES^XPDUTL(.RATXT) K RATXT
;-------------------- Exam Status: Cancelled --------------------------
I '($D(^RA(72,"AA","MAMMOGRAPHY",0))\10) D ; Cancelled not filed.
. S RAFDA(72,"+1,",.01)="CANCELLED",RAFDA(72,"+1,",3)=0
. S RAFDA(72,"+1,",6)="y",RAFDA(72,"+1,",7)=RAITY
. D UPDATE^DIE("","RAFDA","","RAERR")
. I $D(RAERR("DIERR")) D ERMSG72("CANCELLED")
. Q
;------------------ Exam Status: Waiting For Exam ---------------------
I '($D(^RA(72,"AA","MAMMOGRAPHY",1))\10) D ; Waiting For Xam not filed.
. K RAERR,RAFDA
. S RAFDA(72,"+1,",.01)="WAITING FOR EXAM",RAFDA(72,"+1,",3)=1
. S RAFDA(72,"+1,",5)="Y",RAFDA(72,"+1,",6)="y"
. S RAFDA(72,"+1,",7)=RAITY
. F RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315 S RAFDA(72,"+1,",RAI)="y"
. D UPDATE^DIE("","RAFDA","","RAERR")
. I $D(RAERR("DIERR")) D ERMSG72("WAITING FOR EXAM")
. Q
;------------------ Exam Status: Called For Exam ----------------------
I '$$XIST("CALLED FOR EXAM",RAITY) D ; Called For Exam not filed.
. K RAERR,RAFDA
. S RAFDA(72,"+1,",.01)="CALLED FOR EXAM",RAFDA(72,"+1,",6)="y"
. S RAFDA(72,"+1,",7)=RAITY
. F RAI=.11,.21 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315 S RAFDA(72,"+1,",RAI)="y"
. D UPDATE^DIE("","RAFDA","","RAERR")
. I $D(RAERR("DIERR")) D ERMSG72("CALLED FOR EXAM")
. Q
;------------------ Exam Status: Examined -----------------------------
I '$$XIST("EXAMINED",RAITY) D ; Examined not filed.
. K RAERR,RAFDA
. S RAFDA(72,"+1,",.01)="EXAMINED",RAFDA(72,"+1,",7)=RAITY
. F RAI=.11,.13,.14 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.21,.23,.24,.26 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315 S RAFDA(72,"+1,",RAI)="y"
. D UPDATE^DIE("","RAFDA","","RAERR")
. I $D(RAERR("DIERR")) D ERMSG72("EXAMINED")
. Q
;------------------ Exam Status: Transcribed --------------------------
I '$$XIST("TRANSCRIBED",RAITY) D ; Transcribed not filed.
. K RAERR,RAFDA
. S RAFDA(72,"+1,",.01)="TRANSCRIBED",RAFDA(72,"+1,",7)=RAITY
. F RAI=.11,.12,.13,.14,.15,.16,.111 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.22,.25 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315 S RAFDA(72,"+1,",RAI)="y"
. D UPDATE^DIE("","RAFDA","","RAERR")
. I $D(RAERR("DIERR")) D ERMSG72("TRANSCRIBED")
. Q
;------------------ Exam Status: Complete -----------------------------
I '($D(^RA(72,"AA","MAMMOGRAPHY",9))\10) D ; Complete not filed.
. K RAERR,RAFDA
. S RAFDA(72,"+1,",.01)="COMPLETE"
. S RAFDA(72,"+1,",3)=9,RAFDA(72,"+1,",7)=RAITY
. F RAI=.11,.12,.13,.14,.15,.16 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.111,.112,.116 S RAFDA(72,"+1,",RAI)="Y"
. F RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314 S RAFDA(72,"+1,",RAI)="y"
. D UPDATE^DIE("","RAFDA","","RAERR")
. I $D(RAERR("DIERR")) D ERMSG72("COMPLETE")
. Q
Q
;
ERMSG72(X) ; Display error message when an Exam Status is not filed.
N Y
S Y(1)=" ",Y(2)="Error filing `"_X_"' in the Examination Status (72) file.",Y(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
D MES^XPDUTL(.Y)
Q
;
XIST(X,Y) ; Check if an Exam Status for a particular imaging type exists
; in file 72.
; Input: X-Exam Status, Y-imaging type (pointer)
N I,XIT S (I,XIT)=0
F S I=$O(^RA(72,"B",X,I)) Q:I'>0 D Q:XIT
. S:$P($G(^RA(72,I,0)),"^",7)=Y XIT=1
. Q
Q XIT
;
EN2 ; For the HL7 Application Parameter (file 771) 'Radiology',
; change the 'ORU' HL7 Message processing routine from RAHLO
; to the new bridge routine RAHLBKVR.
N %,D,D0,DA,DI,DIC,DIE,DQ,DR,RA771,RA77106,RATXT,X
S RA771=+$$FIND1^DIC(771,"","X","RADIOLOGY")
I 'RA771 D Q ; Can't find 'Radiology' in file 771. Add to 771
. S RATXT(1)=""
. S RATXT(2)="Adding 'Radiology' to the HL7 Application Parameter file."
. S RATXT(3)="Set the 'ORU' HL7 Message Processing Routine field to the"
. S RATXT(4)="new bridge routine RAHLBKVR. Set the 'QRY' HL7 Message"
. S RATXT(5)="Processing Routine field to the new bridge routine"
. S RATXT(6)="RAHLBKVQ." D MES^XPDUTL(.RATXT)
. N RA771,RAFDA S RAFDA(771,"+1,",.01)="RADIOLOGY"
. S RAFDA(771,"+1,",2)="INACTIVE"
. S RAFDA(771.06,"+2,+1,",.01)="ACK"
. S RAFDA(771.06,"+3,+1,",.01)="ORF"
. S RAFDA(771.06,"+4,+1,",.01)="ORU"
. S RAFDA(771.06,"+4,+1,",1)="RAHLBKVR"
. S RAFDA(771.06,"+5,+1,",.01)="QRY"
. S RAFDA(771.06,"+5,+1,",1)="RAHLBKVQ"
. D UPDATE^DIE("E","RAFDA")
. S RA771=+$$FIND1^DIC(771,"","X","RADIOLOGY")
. I RA771 D Q
.. S ^HL(771,RA771,"EC")="~|\&" ; hard set the encoding char field
.. S ^HL(771,RA771,"FS")="^" ; hard set the field seperator field
.. Q
. ; Display error message, 'RADIOLOGY' was not filed!
. K RATXT S RATXT(1)=""
. S RATXT(2)="'RADIOLOGY' could not be added as a HL7 Application"
. S RATXT(3)="Parameter. IRM should investigate." D MES^XPDUTL(.RATXT)
. Q
; The 'RADIOLOGY' entry exists, make sure the right fields are
; populated with the right data.
S:$G(^HL(771,RA771,"EC"))'="~|\&" ^("EC")="~|\&" ; set encoding chars
S:$G(^HL(771,RA771,"FS"))'="~|\&" ^("FS")="^" ; set field seperator
S RA77106("ACK")=$$FIND("ACK")
I 'RA77106("ACK") D ADD("ACK")
I RA77106("ACK") D
. N RAFDA
. S RAFDA(771.06,RA77106("ACK")_","_RA771_",",1)="@" ;no processing rou
. D FILE^DIE("","RAFDA","")
. Q
;
S RA77106("ORF")=$$FIND("ORF")
I 'RA77106("ORF") D ADD("ORF")
I RA77106("ORF") D
. N RAFDA
. S RAFDA(771.06,RA77106("ORF")_","_RA771_",",1)="@" ;no processing rou
. D FILE^DIE("","RAFDA","")
. Q
S RA77106("ORU")=+$$FIND1^DIC(771.06,","_RA771_",","X","ORU")
I 'RA77106("ORU") D ADD("ORU")
I RA77106("ORU") D
. N RAFDA S RAFDA(771.06,RA77106("ORU")_","_RA771_",",1)="RAHLBKVR"
. D FILE^DIE("","RAFDA","")
. Q
S RA77106("QRY")=+$$FIND1^DIC(771.06,","_RA771_",","X","QRY")
I 'RA77106("QRY") D ADD("QRY")
I RA77106("QRY") D
. N RAFDA S RAFDA(771.06,RA77106("QRY")_","_RA771_",",1)="RAHLBKVQ"
. D FILE^DIE("","RAFDA","")
. Q
Q
ADD(X) ; Add the HL7 Message to the 'RADIOLOGY' entry on the HL7 Application
; Parameter file.
; Input: 'X'-the HL7 Message we are trying to add
; Sets: RA77106('X')=the ien of the newly added HL7 Message
N RAFDA S RAFDA(771.06,"+1,"_RA771_",",.01)=X
D UPDATE^DIE("E","RAFDA") S RA77106(X)=$$FIND(X)
Q
FIND(X) ; Find the ien of the various HL7 Messages used by our HL7 Application
; Input: 'X'-the HL7 Message we are trying to find.
; Output: ien of the HL7 Message entry (if exists), else 0
Q +$$FIND1^DIC(771.06,","_RA771_",","X",X)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPST4 7503 printed Nov 22, 2024@17:46:28 Page 2
RAIPST4 ;HIRMFO/GJC - Post-init number four ;12/18/97 09:08
VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+1 ;
EN1 ; Add Exam Statuses with an Imaging Type of 'Mammography'.
+1 ; Exam Statuses created: Cancelled; Waiting For Exam; Called
+2 ; For Exam; Examined; Transcribed and Complete.
+3 NEW RAERR,RAFDA,RAITY,RATXT
SET RATXT(1)=" "
+4 SET RAITY=+$ORDER(^RA(79.2,"B","MAMMOGRAPHY",0))
+5 ; mammography missing as an i-type
IF RAITY=0
Begin DoDot:1
+6 SET RATXT(1)=" "
SET RATXT(2)="Error, 'MAMMOGRAPHY' missing from the Imaging Type (79.2) file."
SET RATXT(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
+7 DO MES^XPDUTL(.RATXT)
+8 QUIT
End DoDot:1
QUIT
+9 SET RATXT(1)=" "
+10 SET RATXT(2)="Add Exam Statuses with an Imaging Type of 'Mammography'."
+11 SET RATXT(3)="Exam Statuses created: Cancelled; Waiting For Exam; Called"
+12 SET RATXT(4)="For Exam; Examined; Transcribed and Complete."
+13 DO MES^XPDUTL(.RATXT)
KILL RATXT
+14 ;-------------------- Exam Status: Cancelled --------------------------
+15 ; Cancelled not filed.
IF '($DATA(^RA(72,"AA","MAMMOGRAPHY",0))\10)
Begin DoDot:1
+16 SET RAFDA(72,"+1,",.01)="CANCELLED"
SET RAFDA(72,"+1,",3)=0
+17 SET RAFDA(72,"+1,",6)="y"
SET RAFDA(72,"+1,",7)=RAITY
+18 DO UPDATE^DIE("","RAFDA","","RAERR")
+19 IF $DATA(RAERR("DIERR"))
DO ERMSG72("CANCELLED")
+20 QUIT
End DoDot:1
+21 ;------------------ Exam Status: Waiting For Exam ---------------------
+22 ; Waiting For Xam not filed.
IF '($DATA(^RA(72,"AA","MAMMOGRAPHY",1))\10)
Begin DoDot:1
+23 KILL RAERR,RAFDA
+24 SET RAFDA(72,"+1,",.01)="WAITING FOR EXAM"
SET RAFDA(72,"+1,",3)=1
+25 SET RAFDA(72,"+1,",5)="Y"
SET RAFDA(72,"+1,",6)="y"
+26 SET RAFDA(72,"+1,",7)=RAITY
+27 FOR RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315
SET RAFDA(72,"+1,",RAI)="y"
+28 DO UPDATE^DIE("","RAFDA","","RAERR")
+29 IF $DATA(RAERR("DIERR"))
DO ERMSG72("WAITING FOR EXAM")
+30 QUIT
End DoDot:1
+31 ;------------------ Exam Status: Called For Exam ----------------------
+32 ; Called For Exam not filed.
IF '$$XIST("CALLED FOR EXAM",RAITY)
Begin DoDot:1
+33 KILL RAERR,RAFDA
+34 SET RAFDA(72,"+1,",.01)="CALLED FOR EXAM"
SET RAFDA(72,"+1,",6)="y"
+35 SET RAFDA(72,"+1,",7)=RAITY
+36 FOR RAI=.11,.21
SET RAFDA(72,"+1,",RAI)="Y"
+37 FOR RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315
SET RAFDA(72,"+1,",RAI)="y"
+38 DO UPDATE^DIE("","RAFDA","","RAERR")
+39 IF $DATA(RAERR("DIERR"))
DO ERMSG72("CALLED FOR EXAM")
+40 QUIT
End DoDot:1
+41 ;------------------ Exam Status: Examined -----------------------------
+42 ; Examined not filed.
IF '$$XIST("EXAMINED",RAITY)
Begin DoDot:1
+43 KILL RAERR,RAFDA
+44 SET RAFDA(72,"+1,",.01)="EXAMINED"
SET RAFDA(72,"+1,",7)=RAITY
+45 FOR RAI=.11,.13,.14
SET RAFDA(72,"+1,",RAI)="Y"
+46 FOR RAI=.21,.23,.24,.26
SET RAFDA(72,"+1,",RAI)="Y"
+47 FOR RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315
SET RAFDA(72,"+1,",RAI)="y"
+48 DO UPDATE^DIE("","RAFDA","","RAERR")
+49 IF $DATA(RAERR("DIERR"))
DO ERMSG72("EXAMINED")
+50 QUIT
End DoDot:1
+51 ;------------------ Exam Status: Transcribed --------------------------
+52 ; Transcribed not filed.
IF '$$XIST("TRANSCRIBED",RAITY)
Begin DoDot:1
+53 KILL RAERR,RAFDA
+54 SET RAFDA(72,"+1,",.01)="TRANSCRIBED"
SET RAFDA(72,"+1,",7)=RAITY
+55 FOR RAI=.11,.12,.13,.14,.15,.16,.111
SET RAFDA(72,"+1,",RAI)="Y"
+56 FOR RAI=.22,.25
SET RAFDA(72,"+1,",RAI)="Y"
+57 FOR RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315
SET RAFDA(72,"+1,",RAI)="y"
+58 DO UPDATE^DIE("","RAFDA","","RAERR")
+59 IF $DATA(RAERR("DIERR"))
DO ERMSG72("TRANSCRIBED")
+60 QUIT
End DoDot:1
+61 ;------------------ Exam Status: Complete -----------------------------
+62 ; Complete not filed.
IF '($DATA(^RA(72,"AA","MAMMOGRAPHY",9))\10)
Begin DoDot:1
+63 KILL RAERR,RAFDA
+64 SET RAFDA(72,"+1,",.01)="COMPLETE"
+65 SET RAFDA(72,"+1,",3)=9
SET RAFDA(72,"+1,",7)=RAITY
+66 FOR RAI=.11,.12,.13,.14,.15,.16
SET RAFDA(72,"+1,",RAI)="Y"
+67 FOR RAI=.111,.112,.116
SET RAFDA(72,"+1,",RAI)="Y"
+68 FOR RAI=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314
SET RAFDA(72,"+1,",RAI)="y"
+69 DO UPDATE^DIE("","RAFDA","","RAERR")
+70 IF $DATA(RAERR("DIERR"))
DO ERMSG72("COMPLETE")
+71 QUIT
End DoDot:1
+72 QUIT
+73 ;
ERMSG72(X) ; Display error message when an Exam Status is not filed.
+1 NEW Y
+2 SET Y(1)=" "
SET Y(2)="Error filing `"_X_"' in the Examination Status (72) file."
SET Y(3)="IRM and the Radiology/Nuclear Medicine ADPAC should investigate."
+3 DO MES^XPDUTL(.Y)
+4 QUIT
+5 ;
XIST(X,Y) ; Check if an Exam Status for a particular imaging type exists
+1 ; in file 72.
+2 ; Input: X-Exam Status, Y-imaging type (pointer)
+3 NEW I,XIT
SET (I,XIT)=0
+4 FOR
SET I=$ORDER(^RA(72,"B",X,I))
if I'>0
QUIT
Begin DoDot:1
+5 if $PIECE($GET(^RA(72,I,0)),"^",7)=Y
SET XIT=1
+6 QUIT
End DoDot:1
if XIT
QUIT
+7 QUIT XIT
+8 ;
EN2 ; For the HL7 Application Parameter (file 771) 'Radiology',
+1 ; change the 'ORU' HL7 Message processing routine from RAHLO
+2 ; to the new bridge routine RAHLBKVR.
+3 NEW %,D,D0,DA,DI,DIC,DIE,DQ,DR,RA771,RA77106,RATXT,X
+4 SET RA771=+$$FIND1^DIC(771,"","X","RADIOLOGY")
+5 ; Can't find 'Radiology' in file 771. Add to 771
IF 'RA771
Begin DoDot:1
+6 SET RATXT(1)=""
+7 SET RATXT(2)="Adding 'Radiology' to the HL7 Application Parameter file."
+8 SET RATXT(3)="Set the 'ORU' HL7 Message Processing Routine field to the"
+9 SET RATXT(4)="new bridge routine RAHLBKVR. Set the 'QRY' HL7 Message"
+10 SET RATXT(5)="Processing Routine field to the new bridge routine"
+11 SET RATXT(6)="RAHLBKVQ."
DO MES^XPDUTL(.RATXT)
+12 NEW RA771,RAFDA
SET RAFDA(771,"+1,",.01)="RADIOLOGY"
+13 SET RAFDA(771,"+1,",2)="INACTIVE"
+14 SET RAFDA(771.06,"+2,+1,",.01)="ACK"
+15 SET RAFDA(771.06,"+3,+1,",.01)="ORF"
+16 SET RAFDA(771.06,"+4,+1,",.01)="ORU"
+17 SET RAFDA(771.06,"+4,+1,",1)="RAHLBKVR"
+18 SET RAFDA(771.06,"+5,+1,",.01)="QRY"
+19 SET RAFDA(771.06,"+5,+1,",1)="RAHLBKVQ"
+20 DO UPDATE^DIE("E","RAFDA")
+21 SET RA771=+$$FIND1^DIC(771,"","X","RADIOLOGY")
+22 IF RA771
Begin DoDot:2
+23 ; hard set the encoding char field
SET ^HL(771,RA771,"EC")="~|\&"
+24 ; hard set the field seperator field
SET ^HL(771,RA771,"FS")="^"
+25 QUIT
End DoDot:2
QUIT
+26 ; Display error message, 'RADIOLOGY' was not filed!
+27 KILL RATXT
SET RATXT(1)=""
+28 SET RATXT(2)="'RADIOLOGY' could not be added as a HL7 Application"
+29 SET RATXT(3)="Parameter. IRM should investigate."
DO MES^XPDUTL(.RATXT)
+30 QUIT
End DoDot:1
QUIT
+31 ; The 'RADIOLOGY' entry exists, make sure the right fields are
+32 ; populated with the right data.
+33 ; set encoding chars
if $GET(^HL(771,RA771,"EC"))'="~|\&"
SET ^("EC")="~|\&"
+34 ; set field seperator
if $GET(^HL(771,RA771,"FS"))'="~|\&"
SET ^("FS")="^"
+35 SET RA77106("ACK")=$$FIND("ACK")
+36 IF 'RA77106("ACK")
DO ADD("ACK")
+37 IF RA77106("ACK")
Begin DoDot:1
+38 NEW RAFDA
+39 ;no processing rou
SET RAFDA(771.06,RA77106("ACK")_","_RA771_",",1)="@"
+40 DO FILE^DIE("","RAFDA","")
+41 QUIT
End DoDot:1
+42 ;
+43 SET RA77106("ORF")=$$FIND("ORF")
+44 IF 'RA77106("ORF")
DO ADD("ORF")
+45 IF RA77106("ORF")
Begin DoDot:1
+46 NEW RAFDA
+47 ;no processing rou
SET RAFDA(771.06,RA77106("ORF")_","_RA771_",",1)="@"
+48 DO FILE^DIE("","RAFDA","")
+49 QUIT
End DoDot:1
+50 SET RA77106("ORU")=+$$FIND1^DIC(771.06,","_RA771_",","X","ORU")
+51 IF 'RA77106("ORU")
DO ADD("ORU")
+52 IF RA77106("ORU")
Begin DoDot:1
+53 NEW RAFDA
SET RAFDA(771.06,RA77106("ORU")_","_RA771_",",1)="RAHLBKVR"
+54 DO FILE^DIE("","RAFDA","")
+55 QUIT
End DoDot:1
+56 SET RA77106("QRY")=+$$FIND1^DIC(771.06,","_RA771_",","X","QRY")
+57 IF 'RA77106("QRY")
DO ADD("QRY")
+58 IF RA77106("QRY")
Begin DoDot:1
+59 NEW RAFDA
SET RAFDA(771.06,RA77106("QRY")_","_RA771_",",1)="RAHLBKVQ"
+60 DO FILE^DIE("","RAFDA","")
+61 QUIT
End DoDot:1
+62 QUIT
ADD(X) ; Add the HL7 Message to the 'RADIOLOGY' entry on the HL7 Application
+1 ; Parameter file.
+2 ; Input: 'X'-the HL7 Message we are trying to add
+3 ; Sets: RA77106('X')=the ien of the newly added HL7 Message
+4 NEW RAFDA
SET RAFDA(771.06,"+1,"_RA771_",",.01)=X
+5 DO UPDATE^DIE("E","RAFDA")
SET RA77106(X)=$$FIND(X)
+6 QUIT
FIND(X) ; Find the ien of the various HL7 Messages used by our HL7 Application
+1 ; Input: 'X'-the HL7 Message we are trying to find.
+2 ; Output: ien of the HL7 Message entry (if exists), else 0
+3 QUIT +$$FIND1^DIC(771.06,","_RA771_",","X",X)
