IBDEI20F ; ; 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,32077,1,3,0)
 ;;=3^Lipoma
 ;;^UTILITY(U,$J,358.3,32077,1,4,0)
 ;;=4^D17.30
 ;;^UTILITY(U,$J,358.3,32077,2)
 ;;=^5002012
 ;;^UTILITY(U,$J,358.3,32078,0)
 ;;=D22.9^^126^1645^11
 ;;^UTILITY(U,$J,358.3,32078,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32078,1,3,0)
 ;;=3^Nevus,Skin
 ;;^UTILITY(U,$J,358.3,32078,1,4,0)
 ;;=4^D22.9
 ;;^UTILITY(U,$J,358.3,32078,2)
 ;;=^5002058
 ;;^UTILITY(U,$J,358.3,32079,0)
 ;;=R21.^^126^1645^12
 ;;^UTILITY(U,$J,358.3,32079,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32079,1,3,0)
 ;;=3^Rash/Skin Eruption
 ;;^UTILITY(U,$J,358.3,32079,1,4,0)
 ;;=4^R21.
 ;;^UTILITY(U,$J,358.3,32079,2)
 ;;=^5019283
 ;;^UTILITY(U,$J,358.3,32080,0)
 ;;=B86.^^126^1645^13
 ;;^UTILITY(U,$J,358.3,32080,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32080,1,3,0)
 ;;=3^Scabies
 ;;^UTILITY(U,$J,358.3,32080,1,4,0)
 ;;=4^B86.
 ;;^UTILITY(U,$J,358.3,32080,2)
 ;;=^108096
 ;;^UTILITY(U,$J,358.3,32081,0)
 ;;=L72.3^^126^1645^6
 ;;^UTILITY(U,$J,358.3,32081,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32081,1,3,0)
 ;;=3^Cyst,Sebaceous
 ;;^UTILITY(U,$J,358.3,32081,1,4,0)
 ;;=4^L72.3
 ;;^UTILITY(U,$J,358.3,32081,2)
 ;;=^5009281
 ;;^UTILITY(U,$J,358.3,32082,0)
 ;;=R22.9^^126^1645^10
 ;;^UTILITY(U,$J,358.3,32082,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32082,1,3,0)
 ;;=3^Mass,Subcutaneous
 ;;^UTILITY(U,$J,358.3,32082,1,4,0)
 ;;=4^R22.9
 ;;^UTILITY(U,$J,358.3,32082,2)
 ;;=^5019292
 ;;^UTILITY(U,$J,358.3,32083,0)
 ;;=B35.4^^126^1645^14
 ;;^UTILITY(U,$J,358.3,32083,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32083,1,3,0)
 ;;=3^Tinea Corporis
 ;;^UTILITY(U,$J,358.3,32083,1,4,0)
 ;;=4^B35.4
 ;;^UTILITY(U,$J,358.3,32083,2)
 ;;=^119704
 ;;^UTILITY(U,$J,358.3,32084,0)
 ;;=Z30.02^^126^1646^13
 ;;^UTILITY(U,$J,358.3,32084,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32084,1,3,0)
 ;;=3^Natural Family Planning Counseling and Instruction
 ;;^UTILITY(U,$J,358.3,32084,1,4,0)
 ;;=4^Z30.02
 ;;^UTILITY(U,$J,358.3,32084,2)
 ;;=^5062816
 ;;^UTILITY(U,$J,358.3,32085,0)
 ;;=Z30.49^^126^1646^1
 ;;^UTILITY(U,$J,358.3,32085,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32085,1,3,0)
 ;;=3^Contraceptive Mgmt NEC
 ;;^UTILITY(U,$J,358.3,32085,1,4,0)
 ;;=4^Z30.49
 ;;^UTILITY(U,$J,358.3,32085,2)
 ;;=^5062826
 ;;^UTILITY(U,$J,358.3,32086,0)
 ;;=Z30.9^^126^1646^2
 ;;^UTILITY(U,$J,358.3,32086,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32086,1,3,0)
 ;;=3^Contraceptive Mgmt NOS
 ;;^UTILITY(U,$J,358.3,32086,1,4,0)
 ;;=4^Z30.9
 ;;^UTILITY(U,$J,358.3,32086,2)
 ;;=^5062828
 ;;^UTILITY(U,$J,358.3,32087,0)
 ;;=Z30.40^^126^1646^3
 ;;^UTILITY(U,$J,358.3,32087,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32087,1,3,0)
 ;;=3^Contraceptive Surveillance
 ;;^UTILITY(U,$J,358.3,32087,1,4,0)
 ;;=4^Z30.40
 ;;^UTILITY(U,$J,358.3,32087,2)
 ;;=^5062819
 ;;^UTILITY(U,$J,358.3,32088,0)
 ;;=Z30.013^^126^1646^4
 ;;^UTILITY(U,$J,358.3,32088,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32088,1,3,0)
 ;;=3^Depo Provera,Initial
 ;;^UTILITY(U,$J,358.3,32088,1,4,0)
 ;;=4^Z30.013
 ;;^UTILITY(U,$J,358.3,32088,2)
 ;;=^5062812
 ;;^UTILITY(U,$J,358.3,32089,0)
 ;;=Z30.018^^126^1646^5
 ;;^UTILITY(U,$J,358.3,32089,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,32089,1,3,0)
 ;;=3^Diaphragm Fit
 ;;^UTILITY(U,$J,358.3,32089,1,4,0)
 ;;=4^Z30.018
 ;;^UTILITY(U,$J,358.3,32089,2)
 ;;=^5062814
 ;;^UTILITY(U,$J,358.3,32090,0)
 ;;=Z30.012^^126^1646^6
 ;;^UTILITY(U,$J,358.3,32090,1,0)
 ;;=^358.31IA^4^2
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI20F   3788     printed  Sep 23, 2025@19:55:21                                                                                                                                                                                                    Page 2
IBDEI20F  ; ; 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,32077,1,3,0)
 +2       ;;=3^Lipoma
 +3       ;;^UTILITY(U,$J,358.3,32077,1,4,0)
 +4       ;;=4^D17.30
 +5       ;;^UTILITY(U,$J,358.3,32077,2)
 +6       ;;=^5002012
 +7       ;;^UTILITY(U,$J,358.3,32078,0)
 +8       ;;=D22.9^^126^1645^11
 +9       ;;^UTILITY(U,$J,358.3,32078,1,0)
 +10      ;;=^358.31IA^4^2
 +11      ;;^UTILITY(U,$J,358.3,32078,1,3,0)
 +12      ;;=3^Nevus,Skin
 +13      ;;^UTILITY(U,$J,358.3,32078,1,4,0)
 +14      ;;=4^D22.9
 +15      ;;^UTILITY(U,$J,358.3,32078,2)
 +16      ;;=^5002058
 +17      ;;^UTILITY(U,$J,358.3,32079,0)
 +18      ;;=R21.^^126^1645^12
 +19      ;;^UTILITY(U,$J,358.3,32079,1,0)
 +20      ;;=^358.31IA^4^2
 +21      ;;^UTILITY(U,$J,358.3,32079,1,3,0)
 +22      ;;=3^Rash/Skin Eruption
 +23      ;;^UTILITY(U,$J,358.3,32079,1,4,0)
 +24      ;;=4^R21.
 +25      ;;^UTILITY(U,$J,358.3,32079,2)
 +26      ;;=^5019283
 +27      ;;^UTILITY(U,$J,358.3,32080,0)
 +28      ;;=B86.^^126^1645^13
 +29      ;;^UTILITY(U,$J,358.3,32080,1,0)
 +30      ;;=^358.31IA^4^2
 +31      ;;^UTILITY(U,$J,358.3,32080,1,3,0)
 +32      ;;=3^Scabies
 +33      ;;^UTILITY(U,$J,358.3,32080,1,4,0)
 +34      ;;=4^B86.
 +35      ;;^UTILITY(U,$J,358.3,32080,2)
 +36      ;;=^108096
 +37      ;;^UTILITY(U,$J,358.3,32081,0)
 +38      ;;=L72.3^^126^1645^6
 +39      ;;^UTILITY(U,$J,358.3,32081,1,0)
 +40      ;;=^358.31IA^4^2
 +41      ;;^UTILITY(U,$J,358.3,32081,1,3,0)
 +42      ;;=3^Cyst,Sebaceous
 +43      ;;^UTILITY(U,$J,358.3,32081,1,4,0)
 +44      ;;=4^L72.3
 +45      ;;^UTILITY(U,$J,358.3,32081,2)
 +46      ;;=^5009281
 +47      ;;^UTILITY(U,$J,358.3,32082,0)
 +48      ;;=R22.9^^126^1645^10
 +49      ;;^UTILITY(U,$J,358.3,32082,1,0)
 +50      ;;=^358.31IA^4^2
 +51      ;;^UTILITY(U,$J,358.3,32082,1,3,0)
 +52      ;;=3^Mass,Subcutaneous
 +53      ;;^UTILITY(U,$J,358.3,32082,1,4,0)
 +54      ;;=4^R22.9
 +55      ;;^UTILITY(U,$J,358.3,32082,2)
 +56      ;;=^5019292
 +57      ;;^UTILITY(U,$J,358.3,32083,0)
 +58      ;;=B35.4^^126^1645^14
 +59      ;;^UTILITY(U,$J,358.3,32083,1,0)
 +60      ;;=^358.31IA^4^2
 +61      ;;^UTILITY(U,$J,358.3,32083,1,3,0)
 +62      ;;=3^Tinea Corporis
 +63      ;;^UTILITY(U,$J,358.3,32083,1,4,0)
 +64      ;;=4^B35.4
 +65      ;;^UTILITY(U,$J,358.3,32083,2)
 +66      ;;=^119704
 +67      ;;^UTILITY(U,$J,358.3,32084,0)
 +68      ;;=Z30.02^^126^1646^13
 +69      ;;^UTILITY(U,$J,358.3,32084,1,0)
 +70      ;;=^358.31IA^4^2
 +71      ;;^UTILITY(U,$J,358.3,32084,1,3,0)
 +72      ;;=3^Natural Family Planning Counseling and Instruction
 +73      ;;^UTILITY(U,$J,358.3,32084,1,4,0)
 +74      ;;=4^Z30.02
 +75      ;;^UTILITY(U,$J,358.3,32084,2)
 +76      ;;=^5062816
 +77      ;;^UTILITY(U,$J,358.3,32085,0)
 +78      ;;=Z30.49^^126^1646^1
 +79      ;;^UTILITY(U,$J,358.3,32085,1,0)
 +80      ;;=^358.31IA^4^2
 +81      ;;^UTILITY(U,$J,358.3,32085,1,3,0)
 +82      ;;=3^Contraceptive Mgmt NEC
 +83      ;;^UTILITY(U,$J,358.3,32085,1,4,0)
 +84      ;;=4^Z30.49
 +85      ;;^UTILITY(U,$J,358.3,32085,2)
 +86      ;;=^5062826
 +87      ;;^UTILITY(U,$J,358.3,32086,0)
 +88      ;;=Z30.9^^126^1646^2
 +89      ;;^UTILITY(U,$J,358.3,32086,1,0)
 +90      ;;=^358.31IA^4^2
 +91      ;;^UTILITY(U,$J,358.3,32086,1,3,0)
 +92      ;;=3^Contraceptive Mgmt NOS
 +93      ;;^UTILITY(U,$J,358.3,32086,1,4,0)
 +94      ;;=4^Z30.9
 +95      ;;^UTILITY(U,$J,358.3,32086,2)
 +96      ;;=^5062828
 +97      ;;^UTILITY(U,$J,358.3,32087,0)
 +98      ;;=Z30.40^^126^1646^3
 +99      ;;^UTILITY(U,$J,358.3,32087,1,0)
 +100     ;;=^358.31IA^4^2
 +101     ;;^UTILITY(U,$J,358.3,32087,1,3,0)
 +102     ;;=3^Contraceptive Surveillance
 +103     ;;^UTILITY(U,$J,358.3,32087,1,4,0)
 +104     ;;=4^Z30.40
 +105     ;;^UTILITY(U,$J,358.3,32087,2)
 +106     ;;=^5062819
 +107     ;;^UTILITY(U,$J,358.3,32088,0)
 +108     ;;=Z30.013^^126^1646^4
 +109     ;;^UTILITY(U,$J,358.3,32088,1,0)
 +110     ;;=^358.31IA^4^2
 +111     ;;^UTILITY(U,$J,358.3,32088,1,3,0)
 +112     ;;=3^Depo Provera,Initial
 +113     ;;^UTILITY(U,$J,358.3,32088,1,4,0)
 +114     ;;=4^Z30.013
 +115     ;;^UTILITY(U,$J,358.3,32088,2)
 +116     ;;=^5062812
 +117     ;;^UTILITY(U,$J,358.3,32089,0)
 +118     ;;=Z30.018^^126^1646^5
 +119     ;;^UTILITY(U,$J,358.3,32089,1,0)
 +120     ;;=^358.31IA^4^2
 +121     ;;^UTILITY(U,$J,358.3,32089,1,3,0)
 +122     ;;=3^Diaphragm Fit
 +123     ;;^UTILITY(U,$J,358.3,32089,1,4,0)
 +124     ;;=4^Z30.018
 +125     ;;^UTILITY(U,$J,358.3,32089,2)
 +126     ;;=^5062814
 +127     ;;^UTILITY(U,$J,358.3,32090,0)
 +128     ;;=Z30.012^^126^1646^6
 +129     ;;^UTILITY(U,$J,358.3,32090,1,0)
 +130     ;;=^358.31IA^4^2