TIULADR.m

TIULADR ; SLC/JER - Adverse Reactions/Allergies ;01/29/04

 ;;1.0;TEXT INTEGRATION UTILITIES;**46,175**;Jun 20, 1997

MAIN(DFN,DISPLAY,TARGET,LINE) ; Control branching

 N TIUI,TIUJ,GMRAL,TIUY

 I +$G(DISPLAY) W !,"Gathering Allergy Data."

 D EN1^GMRADPT ; DBIA #10099

 I $D(GMRAL)'>9 D  G ADRX

 . S LINE=+$G(LINE)+1

 . I $D(GMRAL),GMRAL=0 S @TARGET@(LINE,0)="Patient has answered NKA"

 . E  S @TARGET@(LINE,0)="No Allergy Assessment" ; **175**

 S TIUI=0,TIUY=""

 F  S TIUI=$O(GMRAL(TIUI)) Q:+TIUI'>0  D

 . N X,Y,TIUX

 . S TIUX=$P($G(GMRAL(TIUI)),U,2)

 . S TIUY=$$FILL^TIULS(TIUX,TIUY,79)

 . I TIUY=TIUX S LINE=+$G(LINE)+1

 . S @TARGET@(LINE,0)=TIUY

 . I +$G(DISPLAY) W "."

ADRX Q "~@"_$NA(@TARGET)

TIULADR   ; SLC/JER - Adverse Reactions/Allergies ;01/29/04

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**46,175**;Jun 20, 1997

MAIN(DFN,DISPLAY,TARGET,LINE) ; Control branching

 +1        NEW TIUI,TIUJ,GMRAL,TIUY

 +2        IF +$GET(DISPLAY)

               WRITE !,"Gathering Allergy Data."

 +3       ; DBIA #10099

           DO EN1^GMRADPT

 +4        IF $DATA(GMRAL)'>9

               Begin DoDot:1

 +5                SET LINE=+$GET(LINE)+1

 +6                IF $DATA(GMRAL)

                       IF GMRAL=0

                           SET @TARGET@(LINE,0)="Patient has answered NKA"

 +7       ; **175**

                  IF '$TEST

                       SET @TARGET@(LINE,0)="No Allergy Assessment"

               End DoDot:1

               GOTO ADRX

 +8        SET TIUI=0

           SET TIUY=""

 +9        FOR 

               SET TIUI=$ORDER(GMRAL(TIUI))

               IF +TIUI'>0

                   QUIT 

               Begin DoDot:1

 +10               NEW X,Y,TIUX

 +11               SET TIUX=$PIECE($GET(GMRAL(TIUI)),U,2)

 +12               SET TIUY=$$FILL^TIULS(TIUX,TIUY,79)

 +13               IF TIUY=TIUX

                       SET LINE=+$GET(LINE)+1

 +14               SET @TARGET@(LINE,0)=TIUY

 +15               IF +$GET(DISPLAY)

                       WRITE "."

               End DoDot:1

ADRX       QUIT "~@"_$NAME(@TARGET)