IBDEI1IG ; ; 01-FEB-2022
 ;;3.0;IB ENCOUNTER FORM IMP/EXP;;FEB 01, 2022
 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,24440,1,2,0)
 ;;=2^J9202
 ;;^UTILITY(U,$J,358.3,24440,1,3,0)
 ;;=3^ZOLADEX 3.6MG
 ;;^UTILITY(U,$J,358.3,24441,0)
 ;;=J1642^^83^1060^3^^^^1
 ;;^UTILITY(U,$J,358.3,24441,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24441,1,2,0)
 ;;=2^J1642
 ;;^UTILITY(U,$J,358.3,24441,1,3,0)
 ;;=3^HEP LOCK FLUSH PER 10U
 ;;^UTILITY(U,$J,358.3,24442,0)
 ;;=J1050^^83^1060^4^^^^1
 ;;^UTILITY(U,$J,358.3,24442,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24442,1,2,0)
 ;;=2^J1050
 ;;^UTILITY(U,$J,358.3,24442,1,3,0)
 ;;=3^MEDROXYPROGESTERONE ACETATE 1MG
 ;;^UTILITY(U,$J,358.3,24443,0)
 ;;=J1885^^83^1060^5^^^^1
 ;;^UTILITY(U,$J,358.3,24443,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24443,1,2,0)
 ;;=2^J1885
 ;;^UTILITY(U,$J,358.3,24443,1,3,0)
 ;;=3^TORADOL PER 15MG
 ;;^UTILITY(U,$J,358.3,24444,0)
 ;;=96372^^83^1061^1^^^^1
 ;;^UTILITY(U,$J,358.3,24444,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24444,1,2,0)
 ;;=2^96372
 ;;^UTILITY(U,$J,358.3,24444,1,3,0)
 ;;=3^ADMINISTRATION OF INJ,SC/IM
 ;;^UTILITY(U,$J,358.3,24445,0)
 ;;=69210^^83^1062^1^^^^1
 ;;^UTILITY(U,$J,358.3,24445,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24445,1,2,0)
 ;;=2^69210
 ;;^UTILITY(U,$J,358.3,24445,1,3,0)
 ;;=3^REMOVE IMPACTED EAR WAX
 ;;^UTILITY(U,$J,358.3,24446,0)
 ;;=93005^^83^1063^1^^^^1
 ;;^UTILITY(U,$J,358.3,24446,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24446,1,2,0)
 ;;=2^93005
 ;;^UTILITY(U,$J,358.3,24446,1,3,0)
 ;;=3^ELECTROCARDIOGRAM, TRACING
 ;;^UTILITY(U,$J,358.3,24447,0)
 ;;=10120^^83^1064^1^^^^1
 ;;^UTILITY(U,$J,358.3,24447,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24447,1,2,0)
 ;;=2^10120
 ;;^UTILITY(U,$J,358.3,24447,1,3,0)
 ;;=3^REMOVE FOREIGN BODY
 ;;^UTILITY(U,$J,358.3,24448,0)
 ;;=81002^^83^1065^1^^^^1
 ;;^UTILITY(U,$J,358.3,24448,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24448,1,2,0)
 ;;=2^81002
 ;;^UTILITY(U,$J,358.3,24448,1,3,0)
 ;;=3^URINALYSIS BY DIP STICK
 ;;^UTILITY(U,$J,358.3,24449,0)
 ;;=82948^^83^1065^2^^^^1
 ;;^UTILITY(U,$J,358.3,24449,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24449,1,2,0)
 ;;=2^82948
 ;;^UTILITY(U,$J,358.3,24449,1,3,0)
 ;;=3^FINGERSTICK, GLUCOSE
 ;;^UTILITY(U,$J,358.3,24450,0)
 ;;=J1642^^83^1066^1^^^^1
 ;;^UTILITY(U,$J,358.3,24450,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24450,1,2,0)
 ;;=2^J1642
 ;;^UTILITY(U,$J,358.3,24450,1,3,0)
 ;;=3^HEP LOCK FLUSH PER 10U
 ;;^UTILITY(U,$J,358.3,24451,0)
 ;;=86580^^83^1067^1^^^^1
 ;;^UTILITY(U,$J,358.3,24451,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24451,1,2,0)
 ;;=2^86580
 ;;^UTILITY(U,$J,358.3,24451,1,3,0)
 ;;=3^TB INTRADERMAL TEST
 ;;^UTILITY(U,$J,358.3,24452,0)
 ;;=20610^^83^1068^5^^^^1
 ;;^UTILITY(U,$J,358.3,24452,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24452,1,2,0)
 ;;=2^20610
 ;;^UTILITY(U,$J,358.3,24452,1,3,0)
 ;;=3^DRAIN/INJECT LARGE JOINT
 ;;^UTILITY(U,$J,358.3,24453,0)
 ;;=20600^^83^1068^1^^^^1
 ;;^UTILITY(U,$J,358.3,24453,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24453,1,2,0)
 ;;=2^20600
 ;;^UTILITY(U,$J,358.3,24453,1,3,0)
 ;;=3^DRAIN/INJECT SMALL JOINT
 ;;^UTILITY(U,$J,358.3,24454,0)
 ;;=20605^^83^1068^3^^^^1
 ;;^UTILITY(U,$J,358.3,24454,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24454,1,2,0)
 ;;=2^20605
 ;;^UTILITY(U,$J,358.3,24454,1,3,0)
 ;;=3^DRAIN/INJECT INTERMED JOINT
 ;;^UTILITY(U,$J,358.3,24455,0)
 ;;=20604^^83^1068^2^^^^1
 ;;^UTILITY(U,$J,358.3,24455,1,0)
 ;;=^358.31IA^3^2
 ;;^UTILITY(U,$J,358.3,24455,1,2,0)
 ;;=2^20604
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI1IG   3777     printed  Sep 23, 2025@19:45:22                                                                                                                                                                                                    Page 2
IBDEI1IG  ; ; 01-FEB-2022
 +1       ;;3.0;IB ENCOUNTER FORM IMP/EXP;;FEB 01, 2022
 +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,24440,1,2,0)
 +2       ;;=2^J9202
 +3       ;;^UTILITY(U,$J,358.3,24440,1,3,0)
 +4       ;;=3^ZOLADEX 3.6MG
 +5       ;;^UTILITY(U,$J,358.3,24441,0)
 +6       ;;=J1642^^83^1060^3^^^^1
 +7       ;;^UTILITY(U,$J,358.3,24441,1,0)
 +8       ;;=^358.31IA^3^2
 +9       ;;^UTILITY(U,$J,358.3,24441,1,2,0)
 +10      ;;=2^J1642
 +11      ;;^UTILITY(U,$J,358.3,24441,1,3,0)
 +12      ;;=3^HEP LOCK FLUSH PER 10U
 +13      ;;^UTILITY(U,$J,358.3,24442,0)
 +14      ;;=J1050^^83^1060^4^^^^1
 +15      ;;^UTILITY(U,$J,358.3,24442,1,0)
 +16      ;;=^358.31IA^3^2
 +17      ;;^UTILITY(U,$J,358.3,24442,1,2,0)
 +18      ;;=2^J1050
 +19      ;;^UTILITY(U,$J,358.3,24442,1,3,0)
 +20      ;;=3^MEDROXYPROGESTERONE ACETATE 1MG
 +21      ;;^UTILITY(U,$J,358.3,24443,0)
 +22      ;;=J1885^^83^1060^5^^^^1
 +23      ;;^UTILITY(U,$J,358.3,24443,1,0)
 +24      ;;=^358.31IA^3^2
 +25      ;;^UTILITY(U,$J,358.3,24443,1,2,0)
 +26      ;;=2^J1885
 +27      ;;^UTILITY(U,$J,358.3,24443,1,3,0)
 +28      ;;=3^TORADOL PER 15MG
 +29      ;;^UTILITY(U,$J,358.3,24444,0)
 +30      ;;=96372^^83^1061^1^^^^1
 +31      ;;^UTILITY(U,$J,358.3,24444,1,0)
 +32      ;;=^358.31IA^3^2
 +33      ;;^UTILITY(U,$J,358.3,24444,1,2,0)
 +34      ;;=2^96372
 +35      ;;^UTILITY(U,$J,358.3,24444,1,3,0)
 +36      ;;=3^ADMINISTRATION OF INJ,SC/IM
 +37      ;;^UTILITY(U,$J,358.3,24445,0)
 +38      ;;=69210^^83^1062^1^^^^1
 +39      ;;^UTILITY(U,$J,358.3,24445,1,0)
 +40      ;;=^358.31IA^3^2
 +41      ;;^UTILITY(U,$J,358.3,24445,1,2,0)
 +42      ;;=2^69210
 +43      ;;^UTILITY(U,$J,358.3,24445,1,3,0)
 +44      ;;=3^REMOVE IMPACTED EAR WAX
 +45      ;;^UTILITY(U,$J,358.3,24446,0)
 +46      ;;=93005^^83^1063^1^^^^1
 +47      ;;^UTILITY(U,$J,358.3,24446,1,0)
 +48      ;;=^358.31IA^3^2
 +49      ;;^UTILITY(U,$J,358.3,24446,1,2,0)
 +50      ;;=2^93005
 +51      ;;^UTILITY(U,$J,358.3,24446,1,3,0)
 +52      ;;=3^ELECTROCARDIOGRAM, TRACING
 +53      ;;^UTILITY(U,$J,358.3,24447,0)
 +54      ;;=10120^^83^1064^1^^^^1
 +55      ;;^UTILITY(U,$J,358.3,24447,1,0)
 +56      ;;=^358.31IA^3^2
 +57      ;;^UTILITY(U,$J,358.3,24447,1,2,0)
 +58      ;;=2^10120
 +59      ;;^UTILITY(U,$J,358.3,24447,1,3,0)
 +60      ;;=3^REMOVE FOREIGN BODY
 +61      ;;^UTILITY(U,$J,358.3,24448,0)
 +62      ;;=81002^^83^1065^1^^^^1
 +63      ;;^UTILITY(U,$J,358.3,24448,1,0)
 +64      ;;=^358.31IA^3^2
 +65      ;;^UTILITY(U,$J,358.3,24448,1,2,0)
 +66      ;;=2^81002
 +67      ;;^UTILITY(U,$J,358.3,24448,1,3,0)
 +68      ;;=3^URINALYSIS BY DIP STICK
 +69      ;;^UTILITY(U,$J,358.3,24449,0)
 +70      ;;=82948^^83^1065^2^^^^1
 +71      ;;^UTILITY(U,$J,358.3,24449,1,0)
 +72      ;;=^358.31IA^3^2
 +73      ;;^UTILITY(U,$J,358.3,24449,1,2,0)
 +74      ;;=2^82948
 +75      ;;^UTILITY(U,$J,358.3,24449,1,3,0)
 +76      ;;=3^FINGERSTICK, GLUCOSE
 +77      ;;^UTILITY(U,$J,358.3,24450,0)
 +78      ;;=J1642^^83^1066^1^^^^1
 +79      ;;^UTILITY(U,$J,358.3,24450,1,0)
 +80      ;;=^358.31IA^3^2
 +81      ;;^UTILITY(U,$J,358.3,24450,1,2,0)
 +82      ;;=2^J1642
 +83      ;;^UTILITY(U,$J,358.3,24450,1,3,0)
 +84      ;;=3^HEP LOCK FLUSH PER 10U
 +85      ;;^UTILITY(U,$J,358.3,24451,0)
 +86      ;;=86580^^83^1067^1^^^^1
 +87      ;;^UTILITY(U,$J,358.3,24451,1,0)
 +88      ;;=^358.31IA^3^2
 +89      ;;^UTILITY(U,$J,358.3,24451,1,2,0)
 +90      ;;=2^86580
 +91      ;;^UTILITY(U,$J,358.3,24451,1,3,0)
 +92      ;;=3^TB INTRADERMAL TEST
 +93      ;;^UTILITY(U,$J,358.3,24452,0)
 +94      ;;=20610^^83^1068^5^^^^1
 +95      ;;^UTILITY(U,$J,358.3,24452,1,0)
 +96      ;;=^358.31IA^3^2
 +97      ;;^UTILITY(U,$J,358.3,24452,1,2,0)
 +98      ;;=2^20610
 +99      ;;^UTILITY(U,$J,358.3,24452,1,3,0)
 +100     ;;=3^DRAIN/INJECT LARGE JOINT
 +101     ;;^UTILITY(U,$J,358.3,24453,0)
 +102     ;;=20600^^83^1068^1^^^^1
 +103     ;;^UTILITY(U,$J,358.3,24453,1,0)
 +104     ;;=^358.31IA^3^2
 +105     ;;^UTILITY(U,$J,358.3,24453,1,2,0)
 +106     ;;=2^20600
 +107     ;;^UTILITY(U,$J,358.3,24453,1,3,0)
 +108     ;;=3^DRAIN/INJECT SMALL JOINT
 +109     ;;^UTILITY(U,$J,358.3,24454,0)
 +110     ;;=20605^^83^1068^3^^^^1
 +111     ;;^UTILITY(U,$J,358.3,24454,1,0)
 +112     ;;=^358.31IA^3^2
 +113     ;;^UTILITY(U,$J,358.3,24454,1,2,0)
 +114     ;;=2^20605
 +115     ;;^UTILITY(U,$J,358.3,24454,1,3,0)
 +116     ;;=3^DRAIN/INJECT INTERMED JOINT
 +117     ;;^UTILITY(U,$J,358.3,24455,0)
 +118     ;;=20604^^83^1068^2^^^^1
 +119     ;;^UTILITY(U,$J,358.3,24455,1,0)
 +120     ;;=^358.31IA^3^2
 +121     ;;^UTILITY(U,$J,358.3,24455,1,2,0)
 +122     ;;=2^20604