RA12PST5 ;HIRMFO/CRT - Post-init number five (patch seventeen) ;5/19/99
VERSION ;;5.0;Radiology/Nuclear Medicine;**17**;Mar 16, 1998
;
EN1 ; *** Editing Event Drivers in the Protocol file ***
;
I $D(^ORD(101,"B","RA RPT 2.3")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA RPT 2.3",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORU"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA RPT 2.3",101),UPDATE^DIE("E","RAFDA")
. Q
;
I $D(^ORD(101,"B","RA RPT")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA RPT",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORU"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA RPT",101),UPDATE^DIE("E","RAFDA")
.Q
;
I $D(^ORD(101,"B","RA CANCEL 2.3")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA CANCEL 2.3",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORM"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA CANCEL 2.3",101),UPDATE^DIE("E","RAFDA")
. Q
;
I $D(^ORD(101,"B","RA CANCEL")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA CANCEL",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORM"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA CANCEL",101),UPDATE^DIE("E","RAFDA")
. Q
;
I $D(^ORD(101,"B","RA REG 2.3")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA REG 2.3",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORM"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA REG 2.3",101),UPDATE^DIE("E","RAFDA")
. Q
;
I $D(^ORD(101,"B","RA REG")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA REG",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORM"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA REG",101),UPDATE^DIE("E","RAFDA")
. Q
;
I $D(^ORD(101,"B","RA EXAMINED 2.3")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA EXAMINED 2.3",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORM"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA EXAMINED 2.3",101),UPDATE^DIE("E","RAFDA")
. Q
;
I $D(^ORD(101,"B","RA EXAMINED")) D
. N RA101,RAFDA
. S RA101=$O(^ORD(101,"B","RA EXAMINED",0))
. Q:+RA101'>0
. S RAFDA(101,RA101_",",770.3)="ORM"
. S RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
. S RAFDA(101,RA101_",",770.11)="@"
. D MSG^RA12PST2("RA EXAMINED",101),UPDATE^DIE("E","RAFDA")
. Q
;
; *** End Editing Event Drivers in Protocol File ***
D DELITEM^RA12PST2 ; Delete obsolete ITEM multiples
Q
RA12PST5 ;HIRMFO/CRT - Post-init number five (patch seventeen) ;5/19/99
VERSION ;;5.0;Radiology/Nuclear Medicine;**17**;Mar 16, 1998
+1 ;
EN1 ; *** Editing Event Drivers in the Protocol file ***
+1 ;
+2 IF $DATA(^ORD(101,"B","RA RPT 2.3"))
Begin DoDot:1
+3 NEW RA101,RAFDA
+4 SET RA101=$ORDER(^ORD(101,"B","RA RPT 2.3",0))
+5 IF +RA101'>0
QUIT
+6 SET RAFDA(101,RA101_",",770.3)="ORU"
+7 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+8 SET RAFDA(101,RA101_",",770.11)="@"
+9 DO MSG^RA12PST2("RA RPT 2.3",101)
DO UPDATE^DIE("E","RAFDA")
+10 QUIT
End DoDot:1
+11 ;
+12 IF $DATA(^ORD(101,"B","RA RPT"))
Begin DoDot:1
+13 NEW RA101,RAFDA
+14 SET RA101=$ORDER(^ORD(101,"B","RA RPT",0))
+15 IF +RA101'>0
QUIT
+16 SET RAFDA(101,RA101_",",770.3)="ORU"
+17 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+18 SET RAFDA(101,RA101_",",770.11)="@"
+19 DO MSG^RA12PST2("RA RPT",101)
DO UPDATE^DIE("E","RAFDA")
+20 QUIT
End DoDot:1
+21 ;
+22 IF $DATA(^ORD(101,"B","RA CANCEL 2.3"))
Begin DoDot:1
+23 NEW RA101,RAFDA
+24 SET RA101=$ORDER(^ORD(101,"B","RA CANCEL 2.3",0))
+25 IF +RA101'>0
QUIT
+26 SET RAFDA(101,RA101_",",770.3)="ORM"
+27 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+28 SET RAFDA(101,RA101_",",770.11)="@"
+29 DO MSG^RA12PST2("RA CANCEL 2.3",101)
DO UPDATE^DIE("E","RAFDA")
+30 QUIT
End DoDot:1
+31 ;
+32 IF $DATA(^ORD(101,"B","RA CANCEL"))
Begin DoDot:1
+33 NEW RA101,RAFDA
+34 SET RA101=$ORDER(^ORD(101,"B","RA CANCEL",0))
+35 IF +RA101'>0
QUIT
+36 SET RAFDA(101,RA101_",",770.3)="ORM"
+37 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+38 SET RAFDA(101,RA101_",",770.11)="@"
+39 DO MSG^RA12PST2("RA CANCEL",101)
DO UPDATE^DIE("E","RAFDA")
+40 QUIT
End DoDot:1
+41 ;
+42 IF $DATA(^ORD(101,"B","RA REG 2.3"))
Begin DoDot:1
+43 NEW RA101,RAFDA
+44 SET RA101=$ORDER(^ORD(101,"B","RA REG 2.3",0))
+45 IF +RA101'>0
QUIT
+46 SET RAFDA(101,RA101_",",770.3)="ORM"
+47 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+48 SET RAFDA(101,RA101_",",770.11)="@"
+49 DO MSG^RA12PST2("RA REG 2.3",101)
DO UPDATE^DIE("E","RAFDA")
+50 QUIT
End DoDot:1
+51 ;
+52 IF $DATA(^ORD(101,"B","RA REG"))
Begin DoDot:1
+53 NEW RA101,RAFDA
+54 SET RA101=$ORDER(^ORD(101,"B","RA REG",0))
+55 IF +RA101'>0
QUIT
+56 SET RAFDA(101,RA101_",",770.3)="ORM"
+57 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+58 SET RAFDA(101,RA101_",",770.11)="@"
+59 DO MSG^RA12PST2("RA REG",101)
DO UPDATE^DIE("E","RAFDA")
+60 QUIT
End DoDot:1
+61 ;
+62 IF $DATA(^ORD(101,"B","RA EXAMINED 2.3"))
Begin DoDot:1
+63 NEW RA101,RAFDA
+64 SET RA101=$ORDER(^ORD(101,"B","RA EXAMINED 2.3",0))
+65 IF +RA101'>0
QUIT
+66 SET RAFDA(101,RA101_",",770.3)="ORM"
+67 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+68 SET RAFDA(101,RA101_",",770.11)="@"
+69 DO MSG^RA12PST2("RA EXAMINED 2.3",101)
DO UPDATE^DIE("E","RAFDA")
+70 QUIT
End DoDot:1
+71 ;
+72 IF $DATA(^ORD(101,"B","RA EXAMINED"))
Begin DoDot:1
+73 NEW RA101,RAFDA
+74 SET RA101=$ORDER(^ORD(101,"B","RA EXAMINED",0))
+75 IF +RA101'>0
QUIT
+76 SET RAFDA(101,RA101_",",770.3)="ORM"
+77 SET RAFDA(101,RA101_",",770.6)=$$PROID^RA12PST2()
+78 SET RAFDA(101,RA101_",",770.11)="@"
+79 DO MSG^RA12PST2("RA EXAMINED",101)
DO UPDATE^DIE("E","RAFDA")
+80 QUIT
End DoDot:1
+81 ;
+82 ; *** End Editing Event Drivers in Protocol File ***
+83 ; Delete obsolete ITEM multiples
DO DELITEM^RA12PST2
+84 QUIT
