RA12PST5.m

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