IBDEI2U1.m

IBDEI2U1 ; ; 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,45179,2)

 ;;=^263705

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

 ;;=D23.0^^170^2251^27

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Lip

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

 ;;=4^D23.0

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

 ;;=^5002059

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

 ;;=D23.21^^170^2251^28

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Right Ear/External Auric Canal

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

 ;;=4^D23.21

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

 ;;=^5002064

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

 ;;=D23.22^^170^2251^22

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Left Ear/External Auric Canal

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

 ;;=4^D23.22

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

 ;;=^5002065

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

 ;;=D23.30^^170^2251^21

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Face,Unspec

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

 ;;=4^D23.30

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

 ;;=^5002066

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

 ;;=D23.39^^170^2251^20

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Face NEC

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

 ;;=4^D23.39

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

 ;;=^5002067

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

 ;;=D23.5^^170^2251^34

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Trunk

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

 ;;=4^D23.5

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

 ;;=^5002069

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

 ;;=D23.62^^170^2251^26

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Left Upper Limb

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

 ;;=4^D23.62

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

 ;;=^5002072

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

 ;;=D23.61^^170^2251^32

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Right Upper Limb

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

 ;;=4^D23.61

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

 ;;=^5002071

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

 ;;=D23.71^^170^2251^30

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Right Lower Limb

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

 ;;=4^D23.71

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

 ;;=^5002074

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

 ;;=D23.72^^170^2251^24

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Left Lower Limb

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

 ;;=4^D23.72

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

 ;;=^5002075

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

 ;;=L60.4^^170^2251^17

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

 ;;=^358.31IA^4^2

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

 ;;=3^Beau's Lines

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

 ;;=4^L60.4

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

 ;;=^5009237

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

 ;;=D23.4^^170^2251^33

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

 ;;=^358.31IA^4^2

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

 ;;=3^Benign Neop Skin Scalp and Neck

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

 ;;=4^D23.4

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

 ;;=^5002068

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

 ;;=C44.612^^170^2251^13

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBDEI2U1   3774     printed  Feb 19, 2025@00:02:15                                                                                                                                                                                                    Page 2

IBDEI2U1  ; ; 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,45179,2)

 +2       ;;=^263705

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

 +4       ;;=D23.0^^170^2251^27

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

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

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

 +8       ;;=3^Benign Neop Skin Lip

 +9       ;;^UTILITY(U,$J,358.3,45180,1,4,0)

 +10      ;;=4^D23.0

 +11      ;;^UTILITY(U,$J,358.3,45180,2)

 +12      ;;=^5002059

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

 +14      ;;=D23.21^^170^2251^28

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

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

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

 +18      ;;=3^Benign Neop Skin Right Ear/External Auric Canal

 +19      ;;^UTILITY(U,$J,358.3,45181,1,4,0)

 +20      ;;=4^D23.21

 +21      ;;^UTILITY(U,$J,358.3,45181,2)

 +22      ;;=^5002064

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

 +24      ;;=D23.22^^170^2251^22

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

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

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

 +28      ;;=3^Benign Neop Skin Left Ear/External Auric Canal

 +29      ;;^UTILITY(U,$J,358.3,45182,1,4,0)

 +30      ;;=4^D23.22

 +31      ;;^UTILITY(U,$J,358.3,45182,2)

 +32      ;;=^5002065

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

 +34      ;;=D23.30^^170^2251^21

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

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

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

 +38      ;;=3^Benign Neop Skin Face,Unspec

 +39      ;;^UTILITY(U,$J,358.3,45183,1,4,0)

 +40      ;;=4^D23.30

 +41      ;;^UTILITY(U,$J,358.3,45183,2)

 +42      ;;=^5002066

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

 +44      ;;=D23.39^^170^2251^20

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

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

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

 +48      ;;=3^Benign Neop Skin Face NEC

 +49      ;;^UTILITY(U,$J,358.3,45184,1,4,0)

 +50      ;;=4^D23.39

 +51      ;;^UTILITY(U,$J,358.3,45184,2)

 +52      ;;=^5002067

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

 +54      ;;=D23.5^^170^2251^34

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

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

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

 +58      ;;=3^Benign Neop Skin Trunk

 +59      ;;^UTILITY(U,$J,358.3,45185,1,4,0)

 +60      ;;=4^D23.5

 +61      ;;^UTILITY(U,$J,358.3,45185,2)

 +62      ;;=^5002069

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

 +64      ;;=D23.62^^170^2251^26

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

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

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

 +68      ;;=3^Benign Neop Skin Left Upper Limb

 +69      ;;^UTILITY(U,$J,358.3,45186,1,4,0)

 +70      ;;=4^D23.62

 +71      ;;^UTILITY(U,$J,358.3,45186,2)

 +72      ;;=^5002072

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

 +74      ;;=D23.61^^170^2251^32

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

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

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

 +78      ;;=3^Benign Neop Skin Right Upper Limb

 +79      ;;^UTILITY(U,$J,358.3,45187,1,4,0)

 +80      ;;=4^D23.61

 +81      ;;^UTILITY(U,$J,358.3,45187,2)

 +82      ;;=^5002071

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

 +84      ;;=D23.71^^170^2251^30

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

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

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

 +88      ;;=3^Benign Neop Skin Right Lower Limb

 +89      ;;^UTILITY(U,$J,358.3,45188,1,4,0)

 +90      ;;=4^D23.71

 +91      ;;^UTILITY(U,$J,358.3,45188,2)

 +92      ;;=^5002074

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

 +94      ;;=D23.72^^170^2251^24

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

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

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

 +98      ;;=3^Benign Neop Skin Left Lower Limb

 +99      ;;^UTILITY(U,$J,358.3,45189,1,4,0)

 +100     ;;=4^D23.72

 +101     ;;^UTILITY(U,$J,358.3,45189,2)

 +102     ;;=^5002075

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

 +104     ;;=L60.4^^170^2251^17

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

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

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

 +108     ;;=3^Beau's Lines

 +109     ;;^UTILITY(U,$J,358.3,45190,1,4,0)

 +110     ;;=4^L60.4

 +111     ;;^UTILITY(U,$J,358.3,45190,2)

 +112     ;;=^5009237

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

 +114     ;;=D23.4^^170^2251^33

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

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

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

 +118     ;;=3^Benign Neop Skin Scalp and Neck

 +119     ;;^UTILITY(U,$J,358.3,45191,1,4,0)

 +120     ;;=4^D23.4

 +121     ;;^UTILITY(U,$J,358.3,45191,2)

 +122     ;;=^5002068

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

 +124     ;;=C44.612^^170^2251^13