RAMAIN.m

RAMAIN ;HISC/FPT,GJC,CAH AISC/MJK,RMO;VMP/PW-Utility File Maintenance ;7/24/02  14:45

 ;;5.0;Radiology/Nuclear Medicine;**31,43,50,54,87**;Mar 16, 1998;Build 2

 ;

 ; 11/15/07 BAY/KAM RA*5*87 Rem Call 205080 Option File Access

3 ;;Major AMIS Code Enter/Edit

 N RAI F RAI=1:1:5 W !?9,$P($T(REMIND+RAI),";;",2)

 S DIR(0)="Y",DIR("B")="No"

 S DIR("A")="          add/change any AMIS codes and weight"

 S DIR("A",1)="          Do you have approval from Radiology Service VACO to"

 D ^DIR K DIR Q:$D(DIRUT)  Q:'Y

L3 S DIC="^RAMIS(71.1,",DIC(0)="AEMQ" W ! D ^DIC K DIC I Y<0 K D,X,Y,DDH,I,POP,DISYS Q

 S DA=+Y,DIE="^RAMIS(71.1,",DR=".01;2" D ^DIE K %,%W,%Y,D0,DA,DE,DQ,DIE,DR,DI,I,POP G L3

REMIND ;;

 ;;+----------------------------------------------------------+

 ;;| New entries and modifications to existing entries are    |

 ;;| prohibited without approval from Radiology Service VACO. |

 ;;+----------------------------------------------------------+

 ;

4 ;;Film Type Enter/Edit

 K DD,DIC,DLAYGO,DO

 S DIC="^RA(78.4,",DIC(0)="AEMQL",DLAYGO=78.4 W ! D ^DIC

 K DD,DIC,DLAYGO,DO

 I +Y<0 D  D Q4 Q

 . D DSPLNKS^RAMAIN1

 . K D,DI,X,Y

 . Q

 S DA=+Y,DIE="^RA(78.4,",DR=".01;2;3;4;5;S:+X'=1 Y=""@1"";6;@1"

 D ^DIE S RA784=$G(^RA(78.4,DA,0)),RA784(1)=$P(RA784,U)

 S RA784(5)=+$P(RA784,U,4),RA784(6)=$P(RA784,U,5)

 I RA784(5),(RA784(6)']"") D

 . N DIE,DR

 . W !!?5,$C(7),"'"_RA784(1)_"' has been defined as a wasted film size."

 . W !?5,"If a particular film size is deemed as a wasted piece of"

 . W !?5,"film, the wasted piece of film must be associated with an"

 . W !?5,"unwasted piece of film."

 . W !!?5,"Redefining '"_RA784(1)_"' as an unwasted film size."

 . S DIE="^RA(78.4,",DR="5///@" D ^DIE W "   Done!"

 . Q

 K %,D0,DA,DE,DQ,DIE,DR,RA784,X,Y G 4

Q4 K I,POP,DISYS,DDH

 Q

 ;

5 ;;Diagnostic Code Enter/Edit

 S DIC="^RA(78.3,",DIC(0)="AEMQL",DLAYGO=78.3 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,POP,I Q

 S DA=+Y,DIE="^RA(78.3,",DR="2:5" D ^DIE K %,D0,DA,DE,DQ,DIE,DR,I,DI G 5

 ;

6 ;;Flash Card/Label Formatter

 W:'$D(RAFLH) !!?5,">>> Exam Label/Report Header/Report Footer/Flash Card Formatter <<<"

 S DIC="^RA(78.2,",DIC(0)="AEMQL",DLAYGO=78.2 W ! D ^DIC K DIC,DLAYGO G Q6:Y<0 S (RAFLH,DA)=+Y,DIE="^RA(78.2,",DR="[RA FLASH CARD EDIT]" D ^DIE K DE,DQ,DIE,DR I '$D(^RA(78.2,RAFLH,0)) G Q6

 S RAFMT=RAFLH,RAK=0

 F  S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0  D SETFLH^RAFLH2(RAK)

 D CMP^RAFLH1

 W !!,"<<<<<<----------------------------Column No.------------------------------>>>>>>"

 W !!,"0--------1---------2---------3---------4---------5---------6---------7---------8"

 W !,"1        0         0         0         0         0         0         0         0",! S RATEST="",RANUM=1,RAFFLF="!" D PRT^RAFLH K RAFFLF W !! G 6

Q6 S RAK=0 F  S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0  D KILFLH^RAFLH2(RAK)

 K %,%W,%X,%Y,D,D0,D1,DA,FL,RA787,RATEST,RAII,RAK,RAFLH,RAFMT,RANUM,X,Y

 K POP,I,DDH,DUOUT,DI,DISYS

 Q

 ;

7 ;;Complication Type Enter/Edit

 S DIC="^RA(78.1,",DIC(0)="AEMQL",DLAYGO=78.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y G Q7

 S DA=+Y,DIE="^RA(78.1,",DR=".01;2" D ^DIE K %,D,D0,DA,DE,DQ,DIE,DR D Q7 G 7

Q7 K DI,DISYS,I,POP Q

 ;

8 ;;Sharing/Contract Agreement Entry/Edit

 S DIC="^DIC(34,",DIC(0)="AELMQ",DIC("A")="Select Agreement/Contract: ",DLAYGO=34 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y,I,POP Q

 S DA=+Y,DIE="^DIC(34,",DR=".01:3" D ^DIE K %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS G 8

 ;

9 ;;Standard Reports

 S DIC="^RA(74.1,",DIC(0)="AEMQL",DLAYGO=74.1 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,X,Y D Q9 Q

 S DA=+Y,DIE="^RA(74.1,",DR="[RA STANDARD REPORT ENTRY]" D ^DIE K %,%W,%X,%Y,C,D,D0,DA,DE,DQ,DIE,DR,X,Y D Q9 G 9

Q9 K DDH,DI,DISYS,I,J,POP

 Q

 ;

10 ;;Procedure Modifiers Entry

 K DD,DO,DLAYGO,DIC,DA,DINUM,X,Y

 ;S (DIC,DLAYGO)="^RAMIS(71.2,",DIC(0)="AEMQL"

 ; 11/15/07 BAY/KAM RA*5*87 Rem Call 205080 Changed next line to set DLAYGO equal to the file number instead of the file root

 S DIC="^RAMIS(71.2,",DLAYGO=71.2,DIC(0)="AEMQL"

 S DIC("A")="Select Procedure Modifier: ",DIC("W")="D PROHLP^RAMAIN"

 W ! D ^DIC K DIC,DLAYGO I +Y'>0 K D,X,Y,POP,I,DDH,DG,DISYS,DUOUT Q

 S DIE="^RAMIS(71.2,",DA=+Y,DR="3;4" D ^DIE

 K %W,%X,%Y,D,DIE,DO,DD,DLAYGO,DA,DR,X,Y,POP,I,D0,DI,DISYS,DQ,C G 10

 ;

11 ;;Reports Distribution Edit

 S DIC="^RABTCH(74.3,",DIC(0)="AEMQ" W ! D ^DIC K DIC I Y<0 K D,X,Y,I,POP Q

 S DA=+Y,DIE="^RABTCH(74.3,",DR="[RA DISTRIBUTION EDIT]" D ^DIE K %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS,I,POP G 11

 ;

12 ;;Rad/Nuc Med Procedure Message Enter/Edit

 S DIC="^RAMIS(71.4,",DIC(0)="AELMQ",DLAYGO=71.4

 W ! D ^DIC K DIC,DLAYGO I Y<0 K D,DTOUT,DUOUT,X,Y Q

 S DA=+Y

 L +^RAMIS(71.4,DA):3 I '$T D  G 12 ;*54

 . K DIR S DIR(0)="EA",DIR("A")="Sorry, someone else is editing that entry. <cr> - continue " D ^DIR K DIR

 K RAMLNA,RAMLNB S RAMSGDA=DA ;*50

 S RAMLNA=$G(^RAMIS(71.4,DA,0)) ;*50

 S DIE="^RAMIS(71.4,",DR=.01 D ^DIE

 S RAMLNB=$G(^RAMIS(71.4,+$G(DA),0)) ;*50

 I RAMLNB'=RAMLNA S DA=RAMSGDA D ORDITMS^RAMAIN3 ;*50

 L -^RAMIS(71.4,RAMSGDA) ;*54

 K %,%W,%X,%Y,D0,DA,DE,DQ,DR,DIE,X,Y,RAMLNA,RAMLNB,RAMSGDA

 G 12

 ;

13 ;;Cost of Procedure Enter/Edit

 I '$D(RACCESS(DUZ)) D SET^RAPSET1 I $D(XQUIT) K RACCESS,XQUIT Q

 ; ask img type

 K ^TMP($J,"RA I-TYPE") D SELIMG^RAUTL7 G:$G(RAQUIT) 139

 N RA0,RA1,RA2 S RA0="",RA2=""

131 S RA0=$O(^TMP($J,"RA I-TYPE",RA0)) G:RA0="" 133

132 S RA1=$O(^TMP($J,"RA I-TYPE",RA0,0)) G:'RA1 131

 S RA2=RA1_U_RA2 G 131

133 G:RA2="" 139 S DIC="^RAMIS(71,",DIC(0)="AEMQ"

 ; restrict choice of procedure by img type selected

 S DIC("S")="I RA2[$P(^(0),U,12)"

 W ! D ^DIC K DIC I Y<0 K %,DTOUT,DUOUT,DIC,X,Y G 139

 S DA=+Y,DIE="^RAMIS(71,",DR=10 D ^DIE

 K D,D0,DA,DDH,DI,DIC,DIE,DQ,DR,X

 G 133

139 K ^TMP($J,"RA I-TYPE"),RAQUIT

 Q

 ;

PROHLP ; Help displays the modifiers and all associated imaging types.

 D:'$D(IOM) HOME^%ZIS

 N RAIT,RAIT1,RAIT2,RAIT3 Q:'+$O(^RAMIS(71.2,+Y,1,0))  ; Quit, no data

 S (RAIT,RAIT3)=0

 F  S RAIT=+$O(^RAMIS(71.2,+Y,1,RAIT)) W:'RAIT ")" Q:'RAIT  D

 . S RAIT1=+$G(^RAMIS(71.2,+Y,1,RAIT,0))

 . S RAIT2=$P($G(^RA(79.2,RAIT1,0)),"^",3)

 . W:($X+5)>IOM !?2 W ?$X+1 W:'RAIT3 "(" W RAIT2 S RAIT3=1

 . Q

 Q

RAMAIN    ;HISC/FPT,GJC,CAH AISC/MJK,RMO;VMP/PW-Utility File Maintenance ;7/24/02  14:45

 +1       ;;5.0;Radiology/Nuclear Medicine;**31,43,50,54,87**;Mar 16, 1998;Build 2

 +2       ;

 +3       ; 11/15/07 BAY/KAM RA*5*87 Rem Call 205080 Option File Access

3         ;;Major AMIS Code Enter/Edit

 +1        NEW RAI

           FOR RAI=1:1:5

               WRITE !?9,$PIECE($TEXT(REMIND+RAI),";;",2)

 +2        SET DIR(0)="Y"

           SET DIR("B")="No"

 +3        SET DIR("A")="          add/change any AMIS codes and weight"

 +4        SET DIR("A",1)="          Do you have approval from Radiology Service VACO to"

 +5        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               QUIT 

           IF 'Y

               QUIT 

L3         SET DIC="^RAMIS(71.1,"

           SET DIC(0)="AEMQ"

           WRITE !

           DO ^DIC

           KILL DIC

           IF Y<0

               KILL D,X,Y,DDH,I,POP,DISYS

               QUIT 

 +1        SET DA=+Y

           SET DIE="^RAMIS(71.1,"

           SET DR=".01;2"

           DO ^DIE

           KILL %,%W,%Y,D0,DA,DE,DQ,DIE,DR,DI,I,POP

           GOTO L3

REMIND    ;;

 +1       ;;+----------------------------------------------------------+

 +2       ;;| New entries and modifications to existing entries are    |

 +3       ;;| prohibited without approval from Radiology Service VACO. |

 +4       ;;+----------------------------------------------------------+

 +5       ;

4         ;;Film Type Enter/Edit

 +1        KILL DD,DIC,DLAYGO,DO

 +2        SET DIC="^RA(78.4,"

           SET DIC(0)="AEMQL"

           SET DLAYGO=78.4

           WRITE !

           DO ^DIC

 +3        KILL DD,DIC,DLAYGO,DO

 +4        IF +Y<0

               Begin DoDot:1

 +5                DO DSPLNKS^RAMAIN1

 +6                KILL D,DI,X,Y

 +7                QUIT 

               End DoDot:1

               DO Q4

               QUIT 

 +8        SET DA=+Y

           SET DIE="^RA(78.4,"

           SET DR=".01;2;3;4;5;S:+X'=1 Y=""@1"";6;@1"

 +9        DO ^DIE

           SET RA784=$GET(^RA(78.4,DA,0))

           SET RA784(1)=$PIECE(RA784,U)

 +10       SET RA784(5)=+$PIECE(RA784,U,4)

           SET RA784(6)=$PIECE(RA784,U,5)

 +11       IF RA784(5)

               IF (RA784(6)']"")

                   Begin DoDot:1

 +12                   NEW DIE,DR

 +13                   WRITE !!?5,$CHAR(7),"'"_RA784(1)_"' has been defined as a wasted film size."

 +14                   WRITE !?5,"If a particular film size is deemed as a wasted piece of"

 +15                   WRITE !?5,"film, the wasted piece of film must be associated with an"

 +16                   WRITE !?5,"unwasted piece of film."

 +17                   WRITE !!?5,"Redefining '"_RA784(1)_"' as an unwasted film size."

 +18                   SET DIE="^RA(78.4,"

                       SET DR="5///@"

                       DO ^DIE

                       WRITE "   Done!"

 +19                   QUIT 

                   End DoDot:1

 +20       KILL %,D0,DA,DE,DQ,DIE,DR,RA784,X,Y

           GOTO 4

Q4         KILL I,POP,DISYS,DDH

 +1        QUIT 

 +2       ;

5         ;;Diagnostic Code Enter/Edit

 +1        SET DIC="^RA(78.3,"

           SET DIC(0)="AEMQL"

           SET DLAYGO=78.3

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               KILL D,X,Y,POP,I

               QUIT 

 +2        SET DA=+Y

           SET DIE="^RA(78.3,"

           SET DR="2:5"

           DO ^DIE

           KILL %,D0,DA,DE,DQ,DIE,DR,I,DI

           GOTO 5

 +3       ;

6         ;;Flash Card/Label Formatter

 +1        IF '$DATA(RAFLH)

               WRITE !!?5,">>> Exam Label/Report Header/Report Footer/Flash Card Formatter <<<"

 +2        SET DIC="^RA(78.2,"

           SET DIC(0)="AEMQL"

           SET DLAYGO=78.2

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               GOTO Q6

           SET (RAFLH,DA)=+Y

           SET DIE="^RA(78.2,"

           SET DR="[RA FLASH CARD EDIT]"

           DO ^DIE

           KILL DE,DQ,DIE,DR

           IF '$DATA(^RA(78.2,RAFLH,0))

               GOTO Q6

 +3        SET RAFMT=RAFLH

           SET RAK=0

 +4        FOR 

               SET RAK=$ORDER(^RA(78.7,RAK))

               IF RAK'>0

                   QUIT 

               DO SETFLH^RAFLH2(RAK)

 +5        DO CMP^RAFLH1

 +6        WRITE !!,"<<<<<<----------------------------Column No.------------------------------>>>>>>"

 +7        WRITE !!,"0--------1---------2---------3---------4---------5---------6---------7---------8"

 +8        WRITE !,"1        0         0         0         0         0         0         0         0",!

           SET RATEST=""

           SET RANUM=1

           SET RAFFLF="!"

           DO PRT^RAFLH

           KILL RAFFLF

           WRITE !!

           GOTO 6

Q6         SET RAK=0

           FOR 

               SET RAK=$ORDER(^RA(78.7,RAK))

               IF RAK'>0

                   QUIT 

               DO KILFLH^RAFLH2(RAK)

 +1        KILL %,%W,%X,%Y,D,D0,D1,DA,FL,RA787,RATEST,RAII,RAK,RAFLH,RAFMT,RANUM,X,Y

 +2        KILL POP,I,DDH,DUOUT,DI,DISYS

 +3        QUIT 

 +4       ;

7         ;;Complication Type Enter/Edit

 +1        SET DIC="^RA(78.1,"

           SET DIC(0)="AEMQL"

           SET DLAYGO=78.1

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               KILL D,X,Y

               GOTO Q7

 +2        SET DA=+Y

           SET DIE="^RA(78.1,"

           SET DR=".01;2"

           DO ^DIE

           KILL %,D,D0,DA,DE,DQ,DIE,DR

           DO Q7

           GOTO 7

Q7         KILL DI,DISYS,I,POP

           QUIT 

 +1       ;

8         ;;Sharing/Contract Agreement Entry/Edit

 +1        SET DIC="^DIC(34,"

           SET DIC(0)="AELMQ"

           SET DIC("A")="Select Agreement/Contract: "

           SET DLAYGO=34

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               KILL D,X,Y,I,POP

               QUIT 

 +2        SET DA=+Y

           SET DIE="^DIC(34,"

           SET DR=".01:3"

           DO ^DIE

           KILL %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS

           GOTO 8

 +3       ;

9         ;;Standard Reports

 +1        SET DIC="^RA(74.1,"

           SET DIC(0)="AEMQL"

           SET DLAYGO=74.1

           WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               KILL D,X,Y

               DO Q9

               QUIT 

 +2        SET DA=+Y

           SET DIE="^RA(74.1,"

           SET DR="[RA STANDARD REPORT ENTRY]"

           DO ^DIE

           KILL %,%W,%X,%Y,C,D,D0,DA,DE,DQ,DIE,DR,X,Y

           DO Q9

           GOTO 9

Q9         KILL DDH,DI,DISYS,I,J,POP

 +1        QUIT 

 +2       ;

10        ;;Procedure Modifiers Entry

 +1        KILL DD,DO,DLAYGO,DIC,DA,DINUM,X,Y

 +2       ;S (DIC,DLAYGO)="^RAMIS(71.2,",DIC(0)="AEMQL"

 +3       ; 11/15/07 BAY/KAM RA*5*87 Rem Call 205080 Changed next line to set DLAYGO equal to the file number instead of the file root

 +4        SET DIC="^RAMIS(71.2,"

           SET DLAYGO=71.2

           SET DIC(0)="AEMQL"

 +5        SET DIC("A")="Select Procedure Modifier: "

           SET DIC("W")="D PROHLP^RAMAIN"

 +6        WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF +Y'>0

               KILL D,X,Y,POP,I,DDH,DG,DISYS,DUOUT

               QUIT 

 +7        SET DIE="^RAMIS(71.2,"

           SET DA=+Y

           SET DR="3;4"

           DO ^DIE

 +8        KILL %W,%X,%Y,D,DIE,DO,DD,DLAYGO,DA,DR,X,Y,POP,I,D0,DI,DISYS,DQ,C

           GOTO 10

 +9       ;

11        ;;Reports Distribution Edit

 +1        SET DIC="^RABTCH(74.3,"

           SET DIC(0)="AEMQ"

           WRITE !

           DO ^DIC

           KILL DIC

           IF Y<0

               KILL D,X,Y,I,POP

               QUIT 

 +2        SET DA=+Y

           SET DIE="^RABTCH(74.3,"

           SET DR="[RA DISTRIBUTION EDIT]"

           DO ^DIE

           KILL %,%W,%X,%Y,D,D0,DA,DE,DQ,DIE,DR,X,Y,DI,DISYS,I,POP

           GOTO 11

 +3       ;

12        ;;Rad/Nuc Med Procedure Message Enter/Edit

 +1        SET DIC="^RAMIS(71.4,"

           SET DIC(0)="AELMQ"

           SET DLAYGO=71.4

 +2        WRITE !

           DO ^DIC

           KILL DIC,DLAYGO

           IF Y<0

               KILL D,DTOUT,DUOUT,X,Y

               QUIT 

 +3        SET DA=+Y

 +4       ;*54

           LOCK +^RAMIS(71.4,DA):3

           IF '$TEST

               Begin DoDot:1

 +5                KILL DIR

                   SET DIR(0)="EA"

                   SET DIR("A")="Sorry, someone else is editing that entry. <cr> - continue "

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               GOTO 12

 +6       ;*50

           KILL RAMLNA,RAMLNB

           SET RAMSGDA=DA

 +7       ;*50

           SET RAMLNA=$GET(^RAMIS(71.4,DA,0))

 +8        SET DIE="^RAMIS(71.4,"

           SET DR=.01

           DO ^DIE

 +9       ;*50

           SET RAMLNB=$GET(^RAMIS(71.4,+$GET(DA),0))

 +10      ;*50

           IF RAMLNB'=RAMLNA

               SET DA=RAMSGDA

               DO ORDITMS^RAMAIN3

 +11      ;*54

           LOCK -^RAMIS(71.4,RAMSGDA)

 +12       KILL %,%W,%X,%Y,D0,DA,DE,DQ,DR,DIE,X,Y,RAMLNA,RAMLNB,RAMSGDA

 +13       GOTO 12

 +14      ;

13        ;;Cost of Procedure Enter/Edit

 +1        IF '$DATA(RACCESS(DUZ))

               DO SET^RAPSET1

               IF $DATA(XQUIT)

                   KILL RACCESS,XQUIT

                   QUIT 

 +2       ; ask img type

 +3        KILL ^TMP($JOB,"RA I-TYPE")

           DO SELIMG^RAUTL7

           IF $GET(RAQUIT)

               GOTO 139

 +4        NEW RA0,RA1,RA2

           SET RA0=""

           SET RA2=""

131        SET RA0=$ORDER(^TMP($JOB,"RA I-TYPE",RA0))

           IF RA0=""

               GOTO 133

132        SET RA1=$ORDER(^TMP($JOB,"RA I-TYPE",RA0,0))

           IF 'RA1

               GOTO 131

 +1        SET RA2=RA1_U_RA2

           GOTO 131

133        IF RA2=""

               GOTO 139

           SET DIC="^RAMIS(71,"

           SET DIC(0)="AEMQ"

 +1       ; restrict choice of procedure by img type selected

 +2        SET DIC("S")="I RA2[$P(^(0),U,12)"

 +3        WRITE !

           DO ^DIC

           KILL DIC

           IF Y<0

               KILL %,DTOUT,DUOUT,DIC,X,Y

               GOTO 139

 +4        SET DA=+Y

           SET DIE="^RAMIS(71,"

           SET DR=10

           DO ^DIE

 +5        KILL D,D0,DA,DDH,DI,DIC,DIE,DQ,DR,X

 +6        GOTO 133

139        KILL ^TMP($JOB,"RA I-TYPE"),RAQUIT

 +1        QUIT 

 +2       ;

PROHLP    ; Help displays the modifiers and all associated imaging types.

 +1        IF '$DATA(IOM)

               DO HOME^%ZIS

 +2       ; Quit, no data

           NEW RAIT,RAIT1,RAIT2,RAIT3

           IF '+$ORDER(^RAMIS(71.2,+Y,1,0))

               QUIT 

 +3        SET (RAIT,RAIT3)=0

 +4        FOR 

               SET RAIT=+$ORDER(^RAMIS(71.2,+Y,1,RAIT))

               IF 'RAIT

                   WRITE ")"

               IF 'RAIT

                   QUIT 

               Begin DoDot:1

 +5                SET RAIT1=+$GET(^RAMIS(71.2,+Y,1,RAIT,0))

 +6                SET RAIT2=$PIECE($GET(^RA(79.2,RAIT1,0)),"^",3)

 +7                IF ($X+5)>IOM

                       WRITE !?2

                   WRITE ?$X+1

                   IF 'RAIT3

                       WRITE "("

                   WRITE RAIT2

                   SET RAIT3=1

 +8                QUIT 

               End DoDot:1

 +9        QUIT