- 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)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULADR 714 printed Feb 19, 2025@00:08:32 Page 2
- 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)
