Routine: IBDEI3F3

IBDEI3F3 ; ; 19-NOV-2015

 ;;3.0;IB ENCOUNTER FORM IMP/EXP;;JUN 29, 2015

 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,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y

Q Q

 ;;^UTILITY(U,$J,358.3,57484,0)

 ;;=N97.9^^267^2878^30

 ;;^UTILITY(U,$J,358.3,57484,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57484,1,3,0)

 ;;=3^Female Infertility,Unspec

 ;;^UTILITY(U,$J,358.3,57484,1,4,0)

 ;;=4^N97.9

 ;;^UTILITY(U,$J,358.3,57484,2)

 ;;=^5015935

 ;;^UTILITY(U,$J,358.3,57485,0)

 ;;=R63.0^^267^2878^8

 ;;^UTILITY(U,$J,358.3,57485,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57485,1,3,0)

 ;;=3^Anorexia

 ;;^UTILITY(U,$J,358.3,57485,1,4,0)

 ;;=4^R63.0

 ;;^UTILITY(U,$J,358.3,57485,2)

 ;;=^7939

 ;;^UTILITY(U,$J,358.3,57486,0)

 ;;=R30.0^^267^2878^28

 ;;^UTILITY(U,$J,358.3,57486,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57486,1,3,0)

 ;;=3^Dysuria

 ;;^UTILITY(U,$J,358.3,57486,1,4,0)

 ;;=4^R30.0

 ;;^UTILITY(U,$J,358.3,57486,2)

 ;;=^5019322

 ;;^UTILITY(U,$J,358.3,57487,0)

 ;;=R19.00^^267^2878^38

 ;;^UTILITY(U,$J,358.3,57487,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57487,1,3,0)

 ;;=3^Intra-Abd & Pelvic Swelling/Mass/Lump,Unspec Site

 ;;^UTILITY(U,$J,358.3,57487,1,4,0)

 ;;=4^R19.00

 ;;^UTILITY(U,$J,358.3,57487,2)

 ;;=^5019254

 ;;^UTILITY(U,$J,358.3,57488,0)

 ;;=R92.8^^267^2878^3

 ;;^UTILITY(U,$J,358.3,57488,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57488,1,3,0)

 ;;=3^Abnormal & Inconclusive Findings on Dx Imaging of Breast

 ;;^UTILITY(U,$J,358.3,57488,1,4,0)

 ;;=4^R92.8

 ;;^UTILITY(U,$J,358.3,57488,2)

 ;;=^5019712

 ;;^UTILITY(U,$J,358.3,57489,0)

 ;;=R92.0^^267^2878^43

 ;;^UTILITY(U,$J,358.3,57489,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57489,1,3,0)

 ;;=3^Mammographic Microcalcification on Dx Imaging of Breast

 ;;^UTILITY(U,$J,358.3,57489,1,4,0)

 ;;=4^R92.0

 ;;^UTILITY(U,$J,358.3,57489,2)

 ;;=^5019709

 ;;^UTILITY(U,$J,358.3,57490,0)

 ;;=R92.1^^267^2878^42

 ;;^UTILITY(U,$J,358.3,57490,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57490,1,3,0)

 ;;=3^Mammographic Calcification on Dx Imaging of Breast

 ;;^UTILITY(U,$J,358.3,57490,1,4,0)

 ;;=4^R92.1

 ;;^UTILITY(U,$J,358.3,57490,2)

 ;;=^5019710

 ;;^UTILITY(U,$J,358.3,57491,0)

 ;;=R92.2^^267^2878^36

 ;;^UTILITY(U,$J,358.3,57491,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57491,1,3,0)

 ;;=3^Inconclusive Mammogram

 ;;^UTILITY(U,$J,358.3,57491,1,4,0)

 ;;=4^R92.2

 ;;^UTILITY(U,$J,358.3,57491,2)

 ;;=^5019711

 ;;^UTILITY(U,$J,358.3,57492,0)

 ;;=R87.619^^267^2878^4

 ;;^UTILITY(U,$J,358.3,57492,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57492,1,3,0)

 ;;=3^Abnormal Cytology in Specimen from Cervix Uteri

 ;;^UTILITY(U,$J,358.3,57492,1,4,0)

 ;;=4^R87.619

 ;;^UTILITY(U,$J,358.3,57492,2)

 ;;=^5019676

 ;;^UTILITY(U,$J,358.3,57493,0)

 ;;=R87.610^^267^2878^2

 ;;^UTILITY(U,$J,358.3,57493,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57493,1,3,0)

 ;;=3^ASC-US

 ;;^UTILITY(U,$J,358.3,57493,1,4,0)

 ;;=4^R87.610

 ;;^UTILITY(U,$J,358.3,57493,2)

 ;;=^5019668

 ;;^UTILITY(U,$J,358.3,57494,0)

 ;;=R87.611^^267^2878^1

 ;;^UTILITY(U,$J,358.3,57494,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57494,1,3,0)

 ;;=3^ASC-H

 ;;^UTILITY(U,$J,358.3,57494,1,4,0)

 ;;=4^R87.611

 ;;^UTILITY(U,$J,358.3,57494,2)

 ;;=^5019669

 ;;^UTILITY(U,$J,358.3,57495,0)

 ;;=R87.612^^267^2878^39

 ;;^UTILITY(U,$J,358.3,57495,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57495,1,3,0)

 ;;=3^LGSIL

 ;;^UTILITY(U,$J,358.3,57495,1,4,0)

 ;;=4^R87.612

 ;;^UTILITY(U,$J,358.3,57495,2)

 ;;=^5019670

 ;;^UTILITY(U,$J,358.3,57496,0)

 ;;=R87.613^^267^2878^35

 ;;^UTILITY(U,$J,358.3,57496,1,0)

 ;;=^358.31IA^4^2

 ;;^UTILITY(U,$J,358.3,57496,1,3,0)

 ;;=3^HGSIL

 ;;^UTILITY(U,$J,358.3,57496,1,4,0)

 ;;=4^R87.613

 ;;^UTILITY(U,$J,358.3,57496,2)

 ;;=^5019671

 ;;^UTILITY(U,$J,358.3,57497,0)

 ;;=R87.810^^267^2878^15

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI3F3   3957     printed  Feb 19, 2025@00:13:57                                                                                                                                                                                                    Page 2

IBDEI3F3  ; ; 19-NOV-2015

 +1       ;;3.0;IB ENCOUNTER FORM IMP/EXP;;JUN 29, 2015

 +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,99)

               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,57484,0)

 +2       ;;=N97.9^^267^2878^30

 +3       ;;^UTILITY(U,$J,358.3,57484,1,0)

 +4       ;;=^358.31IA^4^2

 +5       ;;^UTILITY(U,$J,358.3,57484,1,3,0)

 +6       ;;=3^Female Infertility,Unspec

 +7       ;;^UTILITY(U,$J,358.3,57484,1,4,0)

 +8       ;;=4^N97.9

 +9       ;;^UTILITY(U,$J,358.3,57484,2)

 +10      ;;=^5015935

 +11      ;;^UTILITY(U,$J,358.3,57485,0)

 +12      ;;=R63.0^^267^2878^8

 +13      ;;^UTILITY(U,$J,358.3,57485,1,0)

 +14      ;;=^358.31IA^4^2

 +15      ;;^UTILITY(U,$J,358.3,57485,1,3,0)

 +16      ;;=3^Anorexia

 +17      ;;^UTILITY(U,$J,358.3,57485,1,4,0)

 +18      ;;=4^R63.0

 +19      ;;^UTILITY(U,$J,358.3,57485,2)

 +20      ;;=^7939

 +21      ;;^UTILITY(U,$J,358.3,57486,0)

 +22      ;;=R30.0^^267^2878^28

 +23      ;;^UTILITY(U,$J,358.3,57486,1,0)

 +24      ;;=^358.31IA^4^2

 +25      ;;^UTILITY(U,$J,358.3,57486,1,3,0)

 +26      ;;=3^Dysuria

 +27      ;;^UTILITY(U,$J,358.3,57486,1,4,0)

 +28      ;;=4^R30.0

 +29      ;;^UTILITY(U,$J,358.3,57486,2)

 +30      ;;=^5019322

 +31      ;;^UTILITY(U,$J,358.3,57487,0)

 +32      ;;=R19.00^^267^2878^38

 +33      ;;^UTILITY(U,$J,358.3,57487,1,0)

 +34      ;;=^358.31IA^4^2

 +35      ;;^UTILITY(U,$J,358.3,57487,1,3,0)

 +36      ;;=3^Intra-Abd & Pelvic Swelling/Mass/Lump,Unspec Site

 +37      ;;^UTILITY(U,$J,358.3,57487,1,4,0)

 +38      ;;=4^R19.00

 +39      ;;^UTILITY(U,$J,358.3,57487,2)

 +40      ;;=^5019254

 +41      ;;^UTILITY(U,$J,358.3,57488,0)

 +42      ;;=R92.8^^267^2878^3

 +43      ;;^UTILITY(U,$J,358.3,57488,1,0)

 +44      ;;=^358.31IA^4^2

 +45      ;;^UTILITY(U,$J,358.3,57488,1,3,0)

 +46      ;;=3^Abnormal & Inconclusive Findings on Dx Imaging of Breast

 +47      ;;^UTILITY(U,$J,358.3,57488,1,4,0)

 +48      ;;=4^R92.8

 +49      ;;^UTILITY(U,$J,358.3,57488,2)

 +50      ;;=^5019712

 +51      ;;^UTILITY(U,$J,358.3,57489,0)

 +52      ;;=R92.0^^267^2878^43

 +53      ;;^UTILITY(U,$J,358.3,57489,1,0)

 +54      ;;=^358.31IA^4^2

 +55      ;;^UTILITY(U,$J,358.3,57489,1,3,0)

 +56      ;;=3^Mammographic Microcalcification on Dx Imaging of Breast

 +57      ;;^UTILITY(U,$J,358.3,57489,1,4,0)

 +58      ;;=4^R92.0

 +59      ;;^UTILITY(U,$J,358.3,57489,2)

 +60      ;;=^5019709

 +61      ;;^UTILITY(U,$J,358.3,57490,0)

 +62      ;;=R92.1^^267^2878^42

 +63      ;;^UTILITY(U,$J,358.3,57490,1,0)

 +64      ;;=^358.31IA^4^2

 +65      ;;^UTILITY(U,$J,358.3,57490,1,3,0)

 +66      ;;=3^Mammographic Calcification on Dx Imaging of Breast

 +67      ;;^UTILITY(U,$J,358.3,57490,1,4,0)

 +68      ;;=4^R92.1

 +69      ;;^UTILITY(U,$J,358.3,57490,2)

 +70      ;;=^5019710

 +71      ;;^UTILITY(U,$J,358.3,57491,0)

 +72      ;;=R92.2^^267^2878^36

 +73      ;;^UTILITY(U,$J,358.3,57491,1,0)

 +74      ;;=^358.31IA^4^2

 +75      ;;^UTILITY(U,$J,358.3,57491,1,3,0)

 +76      ;;=3^Inconclusive Mammogram

 +77      ;;^UTILITY(U,$J,358.3,57491,1,4,0)

 +78      ;;=4^R92.2

 +79      ;;^UTILITY(U,$J,358.3,57491,2)

 +80      ;;=^5019711

 +81      ;;^UTILITY(U,$J,358.3,57492,0)

 +82      ;;=R87.619^^267^2878^4

 +83      ;;^UTILITY(U,$J,358.3,57492,1,0)

 +84      ;;=^358.31IA^4^2

 +85      ;;^UTILITY(U,$J,358.3,57492,1,3,0)

 +86      ;;=3^Abnormal Cytology in Specimen from Cervix Uteri

 +87      ;;^UTILITY(U,$J,358.3,57492,1,4,0)

 +88      ;;=4^R87.619

 +89      ;;^UTILITY(U,$J,358.3,57492,2)

 +90      ;;=^5019676

 +91      ;;^UTILITY(U,$J,358.3,57493,0)

 +92      ;;=R87.610^^267^2878^2

 +93      ;;^UTILITY(U,$J,358.3,57493,1,0)

 +94      ;;=^358.31IA^4^2

 +95      ;;^UTILITY(U,$J,358.3,57493,1,3,0)

 +96      ;;=3^ASC-US

 +97      ;;^UTILITY(U,$J,358.3,57493,1,4,0)

 +98      ;;=4^R87.610

 +99      ;;^UTILITY(U,$J,358.3,57493,2)

 +100     ;;=^5019668

 +101     ;;^UTILITY(U,$J,358.3,57494,0)

 +102     ;;=R87.611^^267^2878^1

 +103     ;;^UTILITY(U,$J,358.3,57494,1,0)

 +104     ;;=^358.31IA^4^2

 +105     ;;^UTILITY(U,$J,358.3,57494,1,3,0)

 +106     ;;=3^ASC-H

 +107     ;;^UTILITY(U,$J,358.3,57494,1,4,0)

 +108     ;;=4^R87.611

 +109     ;;^UTILITY(U,$J,358.3,57494,2)

 +110     ;;=^5019669

 +111     ;;^UTILITY(U,$J,358.3,57495,0)

 +112     ;;=R87.612^^267^2878^39

 +113     ;;^UTILITY(U,$J,358.3,57495,1,0)

 +114     ;;=^358.31IA^4^2

 +115     ;;^UTILITY(U,$J,358.3,57495,1,3,0)

 +116     ;;=3^LGSIL

 +117     ;;^UTILITY(U,$J,358.3,57495,1,4,0)

 +118     ;;=4^R87.612

 +119     ;;^UTILITY(U,$J,358.3,57495,2)

 +120     ;;=^5019670

 +121     ;;^UTILITY(U,$J,358.3,57496,0)

 +122     ;;=R87.613^^267^2878^35

 +123     ;;^UTILITY(U,$J,358.3,57496,1,0)

 +124     ;;=^358.31IA^4^2

 +125     ;;^UTILITY(U,$J,358.3,57496,1,3,0)

 +126     ;;=3^HGSIL

 +127     ;;^UTILITY(U,$J,358.3,57496,1,4,0)

 +128     ;;=4^R87.613

 +129     ;;^UTILITY(U,$J,358.3,57496,2)

 +130     ;;=^5019671

 +131     ;;^UTILITY(U,$J,358.3,57497,0)

 +132     ;;=R87.810^^267^2878^15

IBDEI3F3.m