IBDEI2T4 ; ; 04-FEB-2020
 ;;3.0;IB ENCOUNTER FORM IMP/EXP;;FEB 04, 2020
 Q:'DIFQR(358.3)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,999) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y
Q Q
 ;;^UTILITY(U,$J,358.3,44771,1,3,0)
 ;;=3^Alopecia Areata,Other
 ;;^UTILITY(U,$J,358.3,44771,1,4,0)
 ;;=4^L63.8
 ;;^UTILITY(U,$J,358.3,44771,2)
 ;;=^5009245
 ;;^UTILITY(U,$J,358.3,44772,0)
 ;;=L63.9^^170^2235^8
 ;;^UTILITY(U,$J,358.3,44772,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44772,1,3,0)
 ;;=3^Alopecia Areata,Unspec
 ;;^UTILITY(U,$J,358.3,44772,1,4,0)
 ;;=4^L63.9
 ;;^UTILITY(U,$J,358.3,44772,2)
 ;;=^5009246
 ;;^UTILITY(U,$J,358.3,44773,0)
 ;;=L70.0^^170^2235^3
 ;;^UTILITY(U,$J,358.3,44773,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44773,1,3,0)
 ;;=3^Acne Vulgaris
 ;;^UTILITY(U,$J,358.3,44773,1,4,0)
 ;;=4^L70.0
 ;;^UTILITY(U,$J,358.3,44773,2)
 ;;=^5009268
 ;;^UTILITY(U,$J,358.3,44774,0)
 ;;=L73.0^^170^2235^2
 ;;^UTILITY(U,$J,358.3,44774,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44774,1,3,0)
 ;;=3^Acne Keloid
 ;;^UTILITY(U,$J,358.3,44774,1,4,0)
 ;;=4^L73.0
 ;;^UTILITY(U,$J,358.3,44774,2)
 ;;=^2149
 ;;^UTILITY(U,$J,358.3,44775,0)
 ;;=L63.0^^170^2235^11
 ;;^UTILITY(U,$J,358.3,44775,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44775,1,3,0)
 ;;=3^Alopecia Totalis
 ;;^UTILITY(U,$J,358.3,44775,1,4,0)
 ;;=4^L63.0
 ;;^UTILITY(U,$J,358.3,44775,2)
 ;;=^5009242
 ;;^UTILITY(U,$J,358.3,44776,0)
 ;;=L63.1^^170^2235^12
 ;;^UTILITY(U,$J,358.3,44776,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44776,1,3,0)
 ;;=3^Alopecia Universalis
 ;;^UTILITY(U,$J,358.3,44776,1,4,0)
 ;;=4^L63.1
 ;;^UTILITY(U,$J,358.3,44776,2)
 ;;=^5009243
 ;;^UTILITY(U,$J,358.3,44777,0)
 ;;=L65.2^^170^2235^10
 ;;^UTILITY(U,$J,358.3,44777,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44777,1,3,0)
 ;;=3^Alopecia Mucinosa
 ;;^UTILITY(U,$J,358.3,44777,1,4,0)
 ;;=4^L65.2
 ;;^UTILITY(U,$J,358.3,44777,2)
 ;;=^5103
 ;;^UTILITY(U,$J,358.3,44778,0)
 ;;=L66.9^^170^2235^9
 ;;^UTILITY(U,$J,358.3,44778,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44778,1,3,0)
 ;;=3^Alopecia Cicatricial,Unspec
 ;;^UTILITY(U,$J,358.3,44778,1,4,0)
 ;;=4^L66.9
 ;;^UTILITY(U,$J,358.3,44778,2)
 ;;=^5009258
 ;;^UTILITY(U,$J,358.3,44779,0)
 ;;=A60.9^^170^2235^14
 ;;^UTILITY(U,$J,358.3,44779,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44779,1,3,0)
 ;;=3^Anogenital Herpesviral Infection,Unspec
 ;;^UTILITY(U,$J,358.3,44779,1,4,0)
 ;;=4^A60.9
 ;;^UTILITY(U,$J,358.3,44779,2)
 ;;=^5000359
 ;;^UTILITY(U,$J,358.3,44780,0)
 ;;=L91.9^^170^2235^4
 ;;^UTILITY(U,$J,358.3,44780,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44780,1,3,0)
 ;;=3^Acrochordon
 ;;^UTILITY(U,$J,358.3,44780,1,4,0)
 ;;=4^L91.9
 ;;^UTILITY(U,$J,358.3,44780,2)
 ;;=^5009461
 ;;^UTILITY(U,$J,358.3,44781,0)
 ;;=L64.8^^170^2235^5
 ;;^UTILITY(U,$J,358.3,44781,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44781,1,3,0)
 ;;=3^Alopecia Androgenic,Other
 ;;^UTILITY(U,$J,358.3,44781,1,4,0)
 ;;=4^L64.8
 ;;^UTILITY(U,$J,358.3,44781,2)
 ;;=^5009248
 ;;^UTILITY(U,$J,358.3,44782,0)
 ;;=L64.9^^170^2235^6
 ;;^UTILITY(U,$J,358.3,44782,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44782,1,3,0)
 ;;=3^Alopecia Androgenic,Unspec
 ;;^UTILITY(U,$J,358.3,44782,1,4,0)
 ;;=4^L64.9
 ;;^UTILITY(U,$J,358.3,44782,2)
 ;;=^5009249
 ;;^UTILITY(U,$J,358.3,44783,0)
 ;;=L56.1^^170^2236^28
 ;;^UTILITY(U,$J,358.3,44783,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,44783,1,3,0)
 ;;=3^Drug Photoallergic Response
 ;;^UTILITY(U,$J,358.3,44783,1,4,0)
 ;;=4^L56.1
 ;;^UTILITY(U,$J,358.3,44783,2)
 ;;=^5009215
 ;;^UTILITY(U,$J,358.3,44784,0)
 ;;=L56.0^^170^2236^29
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI2T4   3753     printed  Sep 23, 2025@20:11:19                                                                                                                                                                                                    Page 2
IBDEI2T4  ; ; 04-FEB-2020
 +1       ;;3.0;IB ENCOUNTER FORM IMP/EXP;;FEB 04, 2020
 +2        if 'DIFQR(358.3)
               QUIT 
           FOR I=1:2
               SET X=$TEXT(Q+I)
               if X=""
                   QUIT 
               SET Y=$EXTRACT($TEXT(Q+I+1),4,999)
               SET X=$EXTRACT(X,4,999)
               if $ASCII(Y)=126
                   SET I=I+1
                   SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,999)
               if $ASCII(Y)=61
                   SET Y=$EXTRACT(Y,2,999)
               XECUTE NO
              IF '$TEST
                   SET @X=Y
Q          QUIT 
 +1       ;;^UTILITY(U,$J,358.3,44771,1,3,0)
 +2       ;;=3^Alopecia Areata,Other
 +3       ;;^UTILITY(U,$J,358.3,44771,1,4,0)
 +4       ;;=4^L63.8
 +5       ;;^UTILITY(U,$J,358.3,44771,2)
 +6       ;;=^5009245
 +7       ;;^UTILITY(U,$J,358.3,44772,0)
 +8       ;;=L63.9^^170^2235^8
 +9       ;;^UTILITY(U,$J,358.3,44772,1,0)
 +10      ;;=^358.31IA^4^2
 +11      ;;^UTILITY(U,$J,358.3,44772,1,3,0)
 +12      ;;=3^Alopecia Areata,Unspec
 +13      ;;^UTILITY(U,$J,358.3,44772,1,4,0)
 +14      ;;=4^L63.9
 +15      ;;^UTILITY(U,$J,358.3,44772,2)
 +16      ;;=^5009246
 +17      ;;^UTILITY(U,$J,358.3,44773,0)
 +18      ;;=L70.0^^170^2235^3
 +19      ;;^UTILITY(U,$J,358.3,44773,1,0)
 +20      ;;=^358.31IA^4^2
 +21      ;;^UTILITY(U,$J,358.3,44773,1,3,0)
 +22      ;;=3^Acne Vulgaris
 +23      ;;^UTILITY(U,$J,358.3,44773,1,4,0)
 +24      ;;=4^L70.0
 +25      ;;^UTILITY(U,$J,358.3,44773,2)
 +26      ;;=^5009268
 +27      ;;^UTILITY(U,$J,358.3,44774,0)
 +28      ;;=L73.0^^170^2235^2
 +29      ;;^UTILITY(U,$J,358.3,44774,1,0)
 +30      ;;=^358.31IA^4^2
 +31      ;;^UTILITY(U,$J,358.3,44774,1,3,0)
 +32      ;;=3^Acne Keloid
 +33      ;;^UTILITY(U,$J,358.3,44774,1,4,0)
 +34      ;;=4^L73.0
 +35      ;;^UTILITY(U,$J,358.3,44774,2)
 +36      ;;=^2149
 +37      ;;^UTILITY(U,$J,358.3,44775,0)
 +38      ;;=L63.0^^170^2235^11
 +39      ;;^UTILITY(U,$J,358.3,44775,1,0)
 +40      ;;=^358.31IA^4^2
 +41      ;;^UTILITY(U,$J,358.3,44775,1,3,0)
 +42      ;;=3^Alopecia Totalis
 +43      ;;^UTILITY(U,$J,358.3,44775,1,4,0)
 +44      ;;=4^L63.0
 +45      ;;^UTILITY(U,$J,358.3,44775,2)
 +46      ;;=^5009242
 +47      ;;^UTILITY(U,$J,358.3,44776,0)
 +48      ;;=L63.1^^170^2235^12
 +49      ;;^UTILITY(U,$J,358.3,44776,1,0)
 +50      ;;=^358.31IA^4^2
 +51      ;;^UTILITY(U,$J,358.3,44776,1,3,0)
 +52      ;;=3^Alopecia Universalis
 +53      ;;^UTILITY(U,$J,358.3,44776,1,4,0)
 +54      ;;=4^L63.1
 +55      ;;^UTILITY(U,$J,358.3,44776,2)
 +56      ;;=^5009243
 +57      ;;^UTILITY(U,$J,358.3,44777,0)
 +58      ;;=L65.2^^170^2235^10
 +59      ;;^UTILITY(U,$J,358.3,44777,1,0)
 +60      ;;=^358.31IA^4^2
 +61      ;;^UTILITY(U,$J,358.3,44777,1,3,0)
 +62      ;;=3^Alopecia Mucinosa
 +63      ;;^UTILITY(U,$J,358.3,44777,1,4,0)
 +64      ;;=4^L65.2
 +65      ;;^UTILITY(U,$J,358.3,44777,2)
 +66      ;;=^5103
 +67      ;;^UTILITY(U,$J,358.3,44778,0)
 +68      ;;=L66.9^^170^2235^9
 +69      ;;^UTILITY(U,$J,358.3,44778,1,0)
 +70      ;;=^358.31IA^4^2
 +71      ;;^UTILITY(U,$J,358.3,44778,1,3,0)
 +72      ;;=3^Alopecia Cicatricial,Unspec
 +73      ;;^UTILITY(U,$J,358.3,44778,1,4,0)
 +74      ;;=4^L66.9
 +75      ;;^UTILITY(U,$J,358.3,44778,2)
 +76      ;;=^5009258
 +77      ;;^UTILITY(U,$J,358.3,44779,0)
 +78      ;;=A60.9^^170^2235^14
 +79      ;;^UTILITY(U,$J,358.3,44779,1,0)
 +80      ;;=^358.31IA^4^2
 +81      ;;^UTILITY(U,$J,358.3,44779,1,3,0)
 +82      ;;=3^Anogenital Herpesviral Infection,Unspec
 +83      ;;^UTILITY(U,$J,358.3,44779,1,4,0)
 +84      ;;=4^A60.9
 +85      ;;^UTILITY(U,$J,358.3,44779,2)
 +86      ;;=^5000359
 +87      ;;^UTILITY(U,$J,358.3,44780,0)
 +88      ;;=L91.9^^170^2235^4
 +89      ;;^UTILITY(U,$J,358.3,44780,1,0)
 +90      ;;=^358.31IA^4^2
 +91      ;;^UTILITY(U,$J,358.3,44780,1,3,0)
 +92      ;;=3^Acrochordon
 +93      ;;^UTILITY(U,$J,358.3,44780,1,4,0)
 +94      ;;=4^L91.9
 +95      ;;^UTILITY(U,$J,358.3,44780,2)
 +96      ;;=^5009461
 +97      ;;^UTILITY(U,$J,358.3,44781,0)
 +98      ;;=L64.8^^170^2235^5
 +99      ;;^UTILITY(U,$J,358.3,44781,1,0)
 +100     ;;=^358.31IA^4^2
 +101     ;;^UTILITY(U,$J,358.3,44781,1,3,0)
 +102     ;;=3^Alopecia Androgenic,Other
 +103     ;;^UTILITY(U,$J,358.3,44781,1,4,0)
 +104     ;;=4^L64.8
 +105     ;;^UTILITY(U,$J,358.3,44781,2)
 +106     ;;=^5009248
 +107     ;;^UTILITY(U,$J,358.3,44782,0)
 +108     ;;=L64.9^^170^2235^6
 +109     ;;^UTILITY(U,$J,358.3,44782,1,0)
 +110     ;;=^358.31IA^4^2
 +111     ;;^UTILITY(U,$J,358.3,44782,1,3,0)
 +112     ;;=3^Alopecia Androgenic,Unspec
 +113     ;;^UTILITY(U,$J,358.3,44782,1,4,0)
 +114     ;;=4^L64.9
 +115     ;;^UTILITY(U,$J,358.3,44782,2)
 +116     ;;=^5009249
 +117     ;;^UTILITY(U,$J,358.3,44783,0)
 +118     ;;=L56.1^^170^2236^28
 +119     ;;^UTILITY(U,$J,358.3,44783,1,0)
 +120     ;;=^358.31IA^4^2
 +121     ;;^UTILITY(U,$J,358.3,44783,1,3,0)
 +122     ;;=3^Drug Photoallergic Response
 +123     ;;^UTILITY(U,$J,358.3,44783,1,4,0)
 +124     ;;=4^L56.1
 +125     ;;^UTILITY(U,$J,358.3,44783,2)
 +126     ;;=^5009215
 +127     ;;^UTILITY(U,$J,358.3,44784,0)
 +128     ;;=L56.0^^170^2236^29