Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDEI2BP

IBDEI2BP.m

Go to the documentation of this file.
IBDEI2BP ; ; 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,37121,2)
 ;;=^5044000
 ;;^UTILITY(U,$J,358.3,37122,0)
 ;;=S90.411A^^146^1912^8
 ;;^UTILITY(U,$J,358.3,37122,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37122,1,3,0)
 ;;=3^Abrasion, rt grt toe, init enc
 ;;^UTILITY(U,$J,358.3,37122,1,4,0)
 ;;=4^S90.411A
 ;;^UTILITY(U,$J,358.3,37122,2)
 ;;=^5043889
 ;;^UTILITY(U,$J,358.3,37123,0)
 ;;=S90.412A^^146^1912^3
 ;;^UTILITY(U,$J,358.3,37123,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37123,1,3,0)
 ;;=3^Abrasion, lft grt toe, init enc
 ;;^UTILITY(U,$J,358.3,37123,1,4,0)
 ;;=4^S90.412A
 ;;^UTILITY(U,$J,358.3,37123,2)
 ;;=^5043892
 ;;^UTILITY(U,$J,358.3,37124,0)
 ;;=S90.414A^^146^1912^9
 ;;^UTILITY(U,$J,358.3,37124,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37124,1,3,0)
 ;;=3^Abrasion, rt lsr toe(s), init enc
 ;;^UTILITY(U,$J,358.3,37124,1,4,0)
 ;;=4^S90.414A
 ;;^UTILITY(U,$J,358.3,37124,2)
 ;;=^5043898
 ;;^UTILITY(U,$J,358.3,37125,0)
 ;;=S90.415A^^146^1912^4
 ;;^UTILITY(U,$J,358.3,37125,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37125,1,3,0)
 ;;=3^Abrasion, lft lsr toe(s), init enc
 ;;^UTILITY(U,$J,358.3,37125,1,4,0)
 ;;=4^S90.415A
 ;;^UTILITY(U,$J,358.3,37125,2)
 ;;=^5043901
 ;;^UTILITY(U,$J,358.3,37126,0)
 ;;=S90.811A^^146^1912^7
 ;;^UTILITY(U,$J,358.3,37126,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37126,1,3,0)
 ;;=3^Abrasion, rt ft, init enc
 ;;^UTILITY(U,$J,358.3,37126,1,4,0)
 ;;=4^S90.811A
 ;;^UTILITY(U,$J,358.3,37126,2)
 ;;=^5044051
 ;;^UTILITY(U,$J,358.3,37127,0)
 ;;=S90.812A^^146^1912^2
 ;;^UTILITY(U,$J,358.3,37127,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37127,1,3,0)
 ;;=3^Abrasion, lft ft, init enc
 ;;^UTILITY(U,$J,358.3,37127,1,4,0)
 ;;=4^S90.812A
 ;;^UTILITY(U,$J,358.3,37127,2)
 ;;=^5044054
 ;;^UTILITY(U,$J,358.3,37128,0)
 ;;=Z98.1^^146^1912^45
 ;;^UTILITY(U,$J,358.3,37128,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37128,1,3,0)
 ;;=3^Arthrodesis status
 ;;^UTILITY(U,$J,358.3,37128,1,4,0)
 ;;=4^Z98.1
 ;;^UTILITY(U,$J,358.3,37128,2)
 ;;=^5063734
 ;;^UTILITY(U,$J,358.3,37129,0)
 ;;=Z89.411^^146^1912^20
 ;;^UTILITY(U,$J,358.3,37129,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37129,1,3,0)
 ;;=3^Absence, acquired of rt grt toe
 ;;^UTILITY(U,$J,358.3,37129,1,4,0)
 ;;=4^Z89.411
 ;;^UTILITY(U,$J,358.3,37129,2)
 ;;=^5063554
 ;;^UTILITY(U,$J,358.3,37130,0)
 ;;=Z89.412^^146^1912^15
 ;;^UTILITY(U,$J,358.3,37130,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37130,1,3,0)
 ;;=3^Absence, acquired of lft grt toe
 ;;^UTILITY(U,$J,358.3,37130,1,4,0)
 ;;=4^Z89.412
 ;;^UTILITY(U,$J,358.3,37130,2)
 ;;=^5063555
 ;;^UTILITY(U,$J,358.3,37131,0)
 ;;=Z89.421^^146^1912^17
 ;;^UTILITY(U,$J,358.3,37131,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37131,1,3,0)
 ;;=3^Absence, acquired of oth rt toe(s)
 ;;^UTILITY(U,$J,358.3,37131,1,4,0)
 ;;=4^Z89.421
 ;;^UTILITY(U,$J,358.3,37131,2)
 ;;=^5063557
 ;;^UTILITY(U,$J,358.3,37132,0)
 ;;=Z89.422^^146^1912^16
 ;;^UTILITY(U,$J,358.3,37132,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37132,1,3,0)
 ;;=3^Absence, acquired of oth lft toe(s)
 ;;^UTILITY(U,$J,358.3,37132,1,4,0)
 ;;=4^Z89.422
 ;;^UTILITY(U,$J,358.3,37132,2)
 ;;=^5063558
 ;;^UTILITY(U,$J,358.3,37133,0)
 ;;=Z89.431^^146^1912^19
 ;;^UTILITY(U,$J,358.3,37133,1,0)
 ;;=^358.31IA^4^2
 ;;^UTILITY(U,$J,358.3,37133,1,3,0)
 ;;=3^Absence, acquired of rt ft
 ;;^UTILITY(U,$J,358.3,37133,1,4,0)
 ;;=4^Z89.431
 ;;^UTILITY(U,$J,358.3,37133,2)
 ;;=^5063560