IBDEI23J ; ; 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,33507,1,4,0)
 ;;=4^S72.352D
 ;;^UTILITY(U,$J,358.3,33507,2)
 ;;=^5038451
 ;;^UTILITY(U,$J,358.3,33508,0)
 ;;=S72.351D^^132^1703^8
 ;;^UTILITY(U,$J,358.3,33508,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33508,1,3,0)
 ;;=3^Displ comminuted fx shaft of right femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33508,1,4,0)
 ;;=4^S72.351D
 ;;^UTILITY(U,$J,358.3,33508,2)
 ;;=^5038435
 ;;^UTILITY(U,$J,358.3,33509,0)
 ;;=S72.354D^^132^1703^14
 ;;^UTILITY(U,$J,358.3,33509,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33509,1,3,0)
 ;;=3^Nondisp commnt fx shaft of right femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33509,1,4,0)
 ;;=4^S72.354D
 ;;^UTILITY(U,$J,358.3,33509,2)
 ;;=^5038483
 ;;^UTILITY(U,$J,358.3,33510,0)
 ;;=S72.355D^^132^1703^12
 ;;^UTILITY(U,$J,358.3,33510,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33510,1,3,0)
 ;;=3^Nondisp commnt fx shaft of left femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33510,1,4,0)
 ;;=4^S72.355D
 ;;^UTILITY(U,$J,358.3,33510,2)
 ;;=^5038499
 ;;^UTILITY(U,$J,358.3,33511,0)
 ;;=M84.552D^^132^1703^16
 ;;^UTILITY(U,$J,358.3,33511,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33511,1,3,0)
 ;;=3^Path fx in neopltc dis, left femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33511,1,4,0)
 ;;=4^M84.552D
 ;;^UTILITY(U,$J,358.3,33511,2)
 ;;=^5014125
 ;;^UTILITY(U,$J,358.3,33512,0)
 ;;=M84.551D^^132^1703^17
 ;;^UTILITY(U,$J,358.3,33512,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33512,1,3,0)
 ;;=3^Path fx in neopltc dis, right femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33512,1,4,0)
 ;;=4^M84.551D
 ;;^UTILITY(U,$J,358.3,33512,2)
 ;;=^5014119
 ;;^UTILITY(U,$J,358.3,33513,0)
 ;;=M84.652D^^132^1703^18
 ;;^UTILITY(U,$J,358.3,33513,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33513,1,3,0)
 ;;=3^Path fx in oth disease, left femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33513,1,4,0)
 ;;=4^M84.652D
 ;;^UTILITY(U,$J,358.3,33513,2)
 ;;=^5134004
 ;;^UTILITY(U,$J,358.3,33514,0)
 ;;=M84.651D^^132^1703^20
 ;;^UTILITY(U,$J,358.3,33514,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33514,1,3,0)
 ;;=3^Path fx in oth disease, right femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33514,1,4,0)
 ;;=4^M84.651D
 ;;^UTILITY(U,$J,358.3,33514,2)
 ;;=^5014263
 ;;^UTILITY(U,$J,358.3,33515,0)
 ;;=M84.452D^^132^1703^24
 ;;^UTILITY(U,$J,358.3,33515,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33515,1,3,0)
 ;;=3^Pathological fracture, left femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33515,1,4,0)
 ;;=4^M84.452D
 ;;^UTILITY(U,$J,358.3,33515,2)
 ;;=^5013909
 ;;^UTILITY(U,$J,358.3,33516,0)
 ;;=M84.451D^^132^1703^26
 ;;^UTILITY(U,$J,358.3,33516,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33516,1,3,0)
 ;;=3^Pathological fracture, right femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33516,1,4,0)
 ;;=4^M84.451D
 ;;^UTILITY(U,$J,358.3,33516,2)
 ;;=^5013903
 ;;^UTILITY(U,$J,358.3,33517,0)
 ;;=M84.352D^^132^1703^28
 ;;^UTILITY(U,$J,358.3,33517,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33517,1,3,0)
 ;;=3^Stress fracture, left femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33517,1,4,0)
 ;;=4^M84.352D
 ;;^UTILITY(U,$J,358.3,33517,2)
 ;;=^5013687
 ;;^UTILITY(U,$J,358.3,33518,0)
 ;;=M84.351D^^132^1703^30
 ;;^UTILITY(U,$J,358.3,33518,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,33518,1,3,0)
 ;;=3^Stress fracture, right femur, subs encntr
 ;;^UTILITY(U,$J,358.3,33518,1,4,0)
 ;;=4^M84.351D
 ;;^UTILITY(U,$J,358.3,33518,2)
 ;;=^5013681
 ;;^UTILITY(U,$J,358.3,33519,0)
 ;;=M00.872^^132^1704^1
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI23J   3780     printed  Sep 23, 2025@19:57:05                                                                                                                                                                                                    Page 2
IBDEI23J  ; ; 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,33507,1,4,0)
 +2       ;;=4^S72.352D
 +3       ;;^UTILITY(U,$J,358.3,33507,2)
 +4       ;;=^5038451
 +5       ;;^UTILITY(U,$J,358.3,33508,0)
 +6       ;;=S72.351D^^132^1703^8
 +7       ;;^UTILITY(U,$J,358.3,33508,1,0)
 +8       ;;=^358.31IA^4^2
 +9       ;;^UTILITY(U,$J,358.3,33508,1,3,0)
 +10      ;;=3^Displ comminuted fx shaft of right femur, subs encntr
 +11      ;;^UTILITY(U,$J,358.3,33508,1,4,0)
 +12      ;;=4^S72.351D
 +13      ;;^UTILITY(U,$J,358.3,33508,2)
 +14      ;;=^5038435
 +15      ;;^UTILITY(U,$J,358.3,33509,0)
 +16      ;;=S72.354D^^132^1703^14
 +17      ;;^UTILITY(U,$J,358.3,33509,1,0)
 +18      ;;=^358.31IA^4^2
 +19      ;;^UTILITY(U,$J,358.3,33509,1,3,0)
 +20      ;;=3^Nondisp commnt fx shaft of right femur, subs encntr
 +21      ;;^UTILITY(U,$J,358.3,33509,1,4,0)
 +22      ;;=4^S72.354D
 +23      ;;^UTILITY(U,$J,358.3,33509,2)
 +24      ;;=^5038483
 +25      ;;^UTILITY(U,$J,358.3,33510,0)
 +26      ;;=S72.355D^^132^1703^12
 +27      ;;^UTILITY(U,$J,358.3,33510,1,0)
 +28      ;;=^358.31IA^4^2
 +29      ;;^UTILITY(U,$J,358.3,33510,1,3,0)
 +30      ;;=3^Nondisp commnt fx shaft of left femur, subs encntr
 +31      ;;^UTILITY(U,$J,358.3,33510,1,4,0)
 +32      ;;=4^S72.355D
 +33      ;;^UTILITY(U,$J,358.3,33510,2)
 +34      ;;=^5038499
 +35      ;;^UTILITY(U,$J,358.3,33511,0)
 +36      ;;=M84.552D^^132^1703^16
 +37      ;;^UTILITY(U,$J,358.3,33511,1,0)
 +38      ;;=^358.31IA^4^2
 +39      ;;^UTILITY(U,$J,358.3,33511,1,3,0)
 +40      ;;=3^Path fx in neopltc dis, left femur, subs encntr
 +41      ;;^UTILITY(U,$J,358.3,33511,1,4,0)
 +42      ;;=4^M84.552D
 +43      ;;^UTILITY(U,$J,358.3,33511,2)
 +44      ;;=^5014125
 +45      ;;^UTILITY(U,$J,358.3,33512,0)
 +46      ;;=M84.551D^^132^1703^17
 +47      ;;^UTILITY(U,$J,358.3,33512,1,0)
 +48      ;;=^358.31IA^4^2
 +49      ;;^UTILITY(U,$J,358.3,33512,1,3,0)
 +50      ;;=3^Path fx in neopltc dis, right femur, subs encntr
 +51      ;;^UTILITY(U,$J,358.3,33512,1,4,0)
 +52      ;;=4^M84.551D
 +53      ;;^UTILITY(U,$J,358.3,33512,2)
 +54      ;;=^5014119
 +55      ;;^UTILITY(U,$J,358.3,33513,0)
 +56      ;;=M84.652D^^132^1703^18
 +57      ;;^UTILITY(U,$J,358.3,33513,1,0)
 +58      ;;=^358.31IA^4^2
 +59      ;;^UTILITY(U,$J,358.3,33513,1,3,0)
 +60      ;;=3^Path fx in oth disease, left femur, subs encntr
 +61      ;;^UTILITY(U,$J,358.3,33513,1,4,0)
 +62      ;;=4^M84.652D
 +63      ;;^UTILITY(U,$J,358.3,33513,2)
 +64      ;;=^5134004
 +65      ;;^UTILITY(U,$J,358.3,33514,0)
 +66      ;;=M84.651D^^132^1703^20
 +67      ;;^UTILITY(U,$J,358.3,33514,1,0)
 +68      ;;=^358.31IA^4^2
 +69      ;;^UTILITY(U,$J,358.3,33514,1,3,0)
 +70      ;;=3^Path fx in oth disease, right femur, subs encntr
 +71      ;;^UTILITY(U,$J,358.3,33514,1,4,0)
 +72      ;;=4^M84.651D
 +73      ;;^UTILITY(U,$J,358.3,33514,2)
 +74      ;;=^5014263
 +75      ;;^UTILITY(U,$J,358.3,33515,0)
 +76      ;;=M84.452D^^132^1703^24
 +77      ;;^UTILITY(U,$J,358.3,33515,1,0)
 +78      ;;=^358.31IA^4^2
 +79      ;;^UTILITY(U,$J,358.3,33515,1,3,0)
 +80      ;;=3^Pathological fracture, left femur, subs encntr
 +81      ;;^UTILITY(U,$J,358.3,33515,1,4,0)
 +82      ;;=4^M84.452D
 +83      ;;^UTILITY(U,$J,358.3,33515,2)
 +84      ;;=^5013909
 +85      ;;^UTILITY(U,$J,358.3,33516,0)
 +86      ;;=M84.451D^^132^1703^26
 +87      ;;^UTILITY(U,$J,358.3,33516,1,0)
 +88      ;;=^358.31IA^4^2
 +89      ;;^UTILITY(U,$J,358.3,33516,1,3,0)
 +90      ;;=3^Pathological fracture, right femur, subs encntr
 +91      ;;^UTILITY(U,$J,358.3,33516,1,4,0)
 +92      ;;=4^M84.451D
 +93      ;;^UTILITY(U,$J,358.3,33516,2)
 +94      ;;=^5013903
 +95      ;;^UTILITY(U,$J,358.3,33517,0)
 +96      ;;=M84.352D^^132^1703^28
 +97      ;;^UTILITY(U,$J,358.3,33517,1,0)
 +98      ;;=^358.31IA^4^2
 +99      ;;^UTILITY(U,$J,358.3,33517,1,3,0)
 +100     ;;=3^Stress fracture, left femur, subs encntr
 +101     ;;^UTILITY(U,$J,358.3,33517,1,4,0)
 +102     ;;=4^M84.352D
 +103     ;;^UTILITY(U,$J,358.3,33517,2)
 +104     ;;=^5013687
 +105     ;;^UTILITY(U,$J,358.3,33518,0)
 +106     ;;=M84.351D^^132^1703^30
 +107     ;;^UTILITY(U,$J,358.3,33518,1,0)
 +108     ;;=^358.31IA^4^2
 +109     ;;^UTILITY(U,$J,358.3,33518,1,3,0)
 +110     ;;=3^Stress fracture, right femur, subs encntr
 +111     ;;^UTILITY(U,$J,358.3,33518,1,4,0)
 +112     ;;=4^M84.351D
 +113     ;;^UTILITY(U,$J,358.3,33518,2)
 +114     ;;=^5013681
 +115     ;;^UTILITY(U,$J,358.3,33519,0)
 +116     ;;=M00.872^^132^1704^1