IBDEI2BI ; ; 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,37028,1,2,0)
 ;;=2^67810
 ;;^UTILITY(U,$J,358.3,37028,1,3,0)
 ;;=3^Bx,Eyelid
 ;;^UTILITY(U,$J,358.3,37029,0)
 ;;=69100^^143^1903^1^^^^1
 ;;^UTILITY(U,$J,358.3,37029,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37029,1,2,0)
 ;;=2^69100
 ;;^UTILITY(U,$J,358.3,37029,1,3,0)
 ;;=3^Bx,External Ear
 ;;^UTILITY(U,$J,358.3,37030,0)
 ;;=40490^^143^1903^5^^^^1
 ;;^UTILITY(U,$J,358.3,37030,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37030,1,2,0)
 ;;=2^40490
 ;;^UTILITY(U,$J,358.3,37030,1,3,0)
 ;;=3^Bx,Lip
 ;;^UTILITY(U,$J,358.3,37031,0)
 ;;=54100^^143^1903^7^^^^1
 ;;^UTILITY(U,$J,358.3,37031,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37031,1,2,0)
 ;;=2^54100
 ;;^UTILITY(U,$J,358.3,37031,1,3,0)
 ;;=3^Bx,Penis
 ;;^UTILITY(U,$J,358.3,37032,0)
 ;;=11755^^143^1903^6^^^^1
 ;;^UTILITY(U,$J,358.3,37032,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37032,1,2,0)
 ;;=2^11755
 ;;^UTILITY(U,$J,358.3,37032,1,3,0)
 ;;=3^Bx,Nail Unit
 ;;^UTILITY(U,$J,358.3,37033,0)
 ;;=56605^^143^1903^12^^^^1
 ;;^UTILITY(U,$J,358.3,37033,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37033,1,2,0)
 ;;=2^56605
 ;;^UTILITY(U,$J,358.3,37033,1,3,0)
 ;;=3^Bx,Vulva/Perineum,Single Lesion
 ;;^UTILITY(U,$J,358.3,37034,0)
 ;;=56606^^143^1903^13^^^^1
 ;;^UTILITY(U,$J,358.3,37034,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37034,1,2,0)
 ;;=2^56606
 ;;^UTILITY(U,$J,358.3,37034,1,3,0)
 ;;=3^Bx,Vulva/Perineum,Ea Addl Lesion
 ;;^UTILITY(U,$J,358.3,37035,0)
 ;;=11106^^143^1903^3^^^^1
 ;;^UTILITY(U,$J,358.3,37035,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37035,1,2,0)
 ;;=2^11106
 ;;^UTILITY(U,$J,358.3,37035,1,3,0)
 ;;=3^Bx,Incisional,Skin,Single Lesion
 ;;^UTILITY(U,$J,358.3,37036,0)
 ;;=11107^^143^1903^4^^^^1
 ;;^UTILITY(U,$J,358.3,37036,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37036,1,2,0)
 ;;=2^11107
 ;;^UTILITY(U,$J,358.3,37036,1,3,0)
 ;;=3^Bx,Incisional,Skin,Ea Addl Lesion
 ;;^UTILITY(U,$J,358.3,37037,0)
 ;;=11104^^143^1903^8^^^^1
 ;;^UTILITY(U,$J,358.3,37037,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37037,1,2,0)
 ;;=2^11104
 ;;^UTILITY(U,$J,358.3,37037,1,3,0)
 ;;=3^Bx,Punch,Skin,Single Lesion
 ;;^UTILITY(U,$J,358.3,37038,0)
 ;;=11105^^143^1903^9^^^^1
 ;;^UTILITY(U,$J,358.3,37038,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37038,1,2,0)
 ;;=2^11105
 ;;^UTILITY(U,$J,358.3,37038,1,3,0)
 ;;=3^Bx,Punch,Skin,Ea Addl Lesion
 ;;^UTILITY(U,$J,358.3,37039,0)
 ;;=11102^^143^1903^10^^^^1
 ;;^UTILITY(U,$J,358.3,37039,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37039,1,2,0)
 ;;=2^11102
 ;;^UTILITY(U,$J,358.3,37039,1,3,0)
 ;;=3^Bx,Tangential,Skin,Single Lesion
 ;;^UTILITY(U,$J,358.3,37040,0)
 ;;=11103^^143^1903^11^^^^1
 ;;^UTILITY(U,$J,358.3,37040,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37040,1,2,0)
 ;;=2^11103
 ;;^UTILITY(U,$J,358.3,37040,1,3,0)
 ;;=3^Bx,Tangential,Skin,Ea Addl Lesion
 ;;^UTILITY(U,$J,358.3,37041,0)
 ;;=14301^^143^1904^1^^^^1
 ;;^UTILITY(U,$J,358.3,37041,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37041,1,2,0)
 ;;=2^14301
 ;;^UTILITY(U,$J,358.3,37041,1,3,0)
 ;;=3^Tissue Rearrangement,30.1-60.0sq cm
 ;;^UTILITY(U,$J,358.3,37042,0)
 ;;=14302^^143^1904^2^^^^1
 ;;^UTILITY(U,$J,358.3,37042,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,37042,1,2,0)
 ;;=2^14302
 ;;^UTILITY(U,$J,358.3,37042,1,3,0)
 ;;=3^Tissue Rearrangement,Ea Addl 30.0sq cm
 ;;^UTILITY(U,$J,358.3,37043,0)
 ;;=15050^^143^1905^11^^^^1
 ;;^UTILITY(U,$J,358.3,37043,1,0)
 ;;=^358.31IA^3^2
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI2BI   3782     printed  Sep 23, 2025@20:01:31                                                                                                                                                                                                    Page 2
IBDEI2BI  ; ; 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,37028,1,2,0)
 +2       ;;=2^67810
 +3       ;;^UTILITY(U,$J,358.3,37028,1,3,0)
 +4       ;;=3^Bx,Eyelid
 +5       ;;^UTILITY(U,$J,358.3,37029,0)
 +6       ;;=69100^^143^1903^1^^^^1
 +7       ;;^UTILITY(U,$J,358.3,37029,1,0)
 +8       ;;=^358.31IA^3^2
 +9       ;;^UTILITY(U,$J,358.3,37029,1,2,0)
 +10      ;;=2^69100
 +11      ;;^UTILITY(U,$J,358.3,37029,1,3,0)
 +12      ;;=3^Bx,External Ear
 +13      ;;^UTILITY(U,$J,358.3,37030,0)
 +14      ;;=40490^^143^1903^5^^^^1
 +15      ;;^UTILITY(U,$J,358.3,37030,1,0)
 +16      ;;=^358.31IA^3^2
 +17      ;;^UTILITY(U,$J,358.3,37030,1,2,0)
 +18      ;;=2^40490
 +19      ;;^UTILITY(U,$J,358.3,37030,1,3,0)
 +20      ;;=3^Bx,Lip
 +21      ;;^UTILITY(U,$J,358.3,37031,0)
 +22      ;;=54100^^143^1903^7^^^^1
 +23      ;;^UTILITY(U,$J,358.3,37031,1,0)
 +24      ;;=^358.31IA^3^2
 +25      ;;^UTILITY(U,$J,358.3,37031,1,2,0)
 +26      ;;=2^54100
 +27      ;;^UTILITY(U,$J,358.3,37031,1,3,0)
 +28      ;;=3^Bx,Penis
 +29      ;;^UTILITY(U,$J,358.3,37032,0)
 +30      ;;=11755^^143^1903^6^^^^1
 +31      ;;^UTILITY(U,$J,358.3,37032,1,0)
 +32      ;;=^358.31IA^3^2
 +33      ;;^UTILITY(U,$J,358.3,37032,1,2,0)
 +34      ;;=2^11755
 +35      ;;^UTILITY(U,$J,358.3,37032,1,3,0)
 +36      ;;=3^Bx,Nail Unit
 +37      ;;^UTILITY(U,$J,358.3,37033,0)
 +38      ;;=56605^^143^1903^12^^^^1
 +39      ;;^UTILITY(U,$J,358.3,37033,1,0)
 +40      ;;=^358.31IA^3^2
 +41      ;;^UTILITY(U,$J,358.3,37033,1,2,0)
 +42      ;;=2^56605
 +43      ;;^UTILITY(U,$J,358.3,37033,1,3,0)
 +44      ;;=3^Bx,Vulva/Perineum,Single Lesion
 +45      ;;^UTILITY(U,$J,358.3,37034,0)
 +46      ;;=56606^^143^1903^13^^^^1
 +47      ;;^UTILITY(U,$J,358.3,37034,1,0)
 +48      ;;=^358.31IA^3^2
 +49      ;;^UTILITY(U,$J,358.3,37034,1,2,0)
 +50      ;;=2^56606
 +51      ;;^UTILITY(U,$J,358.3,37034,1,3,0)
 +52      ;;=3^Bx,Vulva/Perineum,Ea Addl Lesion
 +53      ;;^UTILITY(U,$J,358.3,37035,0)
 +54      ;;=11106^^143^1903^3^^^^1
 +55      ;;^UTILITY(U,$J,358.3,37035,1,0)
 +56      ;;=^358.31IA^3^2
 +57      ;;^UTILITY(U,$J,358.3,37035,1,2,0)
 +58      ;;=2^11106
 +59      ;;^UTILITY(U,$J,358.3,37035,1,3,0)
 +60      ;;=3^Bx,Incisional,Skin,Single Lesion
 +61      ;;^UTILITY(U,$J,358.3,37036,0)
 +62      ;;=11107^^143^1903^4^^^^1
 +63      ;;^UTILITY(U,$J,358.3,37036,1,0)
 +64      ;;=^358.31IA^3^2
 +65      ;;^UTILITY(U,$J,358.3,37036,1,2,0)
 +66      ;;=2^11107
 +67      ;;^UTILITY(U,$J,358.3,37036,1,3,0)
 +68      ;;=3^Bx,Incisional,Skin,Ea Addl Lesion
 +69      ;;^UTILITY(U,$J,358.3,37037,0)
 +70      ;;=11104^^143^1903^8^^^^1
 +71      ;;^UTILITY(U,$J,358.3,37037,1,0)
 +72      ;;=^358.31IA^3^2
 +73      ;;^UTILITY(U,$J,358.3,37037,1,2,0)
 +74      ;;=2^11104
 +75      ;;^UTILITY(U,$J,358.3,37037,1,3,0)
 +76      ;;=3^Bx,Punch,Skin,Single Lesion
 +77      ;;^UTILITY(U,$J,358.3,37038,0)
 +78      ;;=11105^^143^1903^9^^^^1
 +79      ;;^UTILITY(U,$J,358.3,37038,1,0)
 +80      ;;=^358.31IA^3^2
 +81      ;;^UTILITY(U,$J,358.3,37038,1,2,0)
 +82      ;;=2^11105
 +83      ;;^UTILITY(U,$J,358.3,37038,1,3,0)
 +84      ;;=3^Bx,Punch,Skin,Ea Addl Lesion
 +85      ;;^UTILITY(U,$J,358.3,37039,0)
 +86      ;;=11102^^143^1903^10^^^^1
 +87      ;;^UTILITY(U,$J,358.3,37039,1,0)
 +88      ;;=^358.31IA^3^2
 +89      ;;^UTILITY(U,$J,358.3,37039,1,2,0)
 +90      ;;=2^11102
 +91      ;;^UTILITY(U,$J,358.3,37039,1,3,0)
 +92      ;;=3^Bx,Tangential,Skin,Single Lesion
 +93      ;;^UTILITY(U,$J,358.3,37040,0)
 +94      ;;=11103^^143^1903^11^^^^1
 +95      ;;^UTILITY(U,$J,358.3,37040,1,0)
 +96      ;;=^358.31IA^3^2
 +97      ;;^UTILITY(U,$J,358.3,37040,1,2,0)
 +98      ;;=2^11103
 +99      ;;^UTILITY(U,$J,358.3,37040,1,3,0)
 +100     ;;=3^Bx,Tangential,Skin,Ea Addl Lesion
 +101     ;;^UTILITY(U,$J,358.3,37041,0)
 +102     ;;=14301^^143^1904^1^^^^1
 +103     ;;^UTILITY(U,$J,358.3,37041,1,0)
 +104     ;;=^358.31IA^3^2
 +105     ;;^UTILITY(U,$J,358.3,37041,1,2,0)
 +106     ;;=2^14301
 +107     ;;^UTILITY(U,$J,358.3,37041,1,3,0)
 +108     ;;=3^Tissue Rearrangement,30.1-60.0sq cm
 +109     ;;^UTILITY(U,$J,358.3,37042,0)
 +110     ;;=14302^^143^1904^2^^^^1
 +111     ;;^UTILITY(U,$J,358.3,37042,1,0)
 +112     ;;=^358.31IA^3^2
 +113     ;;^UTILITY(U,$J,358.3,37042,1,2,0)
 +114     ;;=2^14302
 +115     ;;^UTILITY(U,$J,358.3,37042,1,3,0)
 +116     ;;=3^Tissue Rearrangement,Ea Addl 30.0sq cm
 +117     ;;^UTILITY(U,$J,358.3,37043,0)
 +118     ;;=15050^^143^1905^11^^^^1
 +119     ;;^UTILITY(U,$J,358.3,37043,1,0)
 +120     ;;=^358.31IA^3^2