IBDEI3JW ; ; 19-NOV-2015
;;3.0;IB ENCOUNTER FORM IMP/EXP;;JUN 29, 2015
Q:'DIFQR(358.6) 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.6,9,13,3,0)
;;=3;IBD(358.98,^^1^^^^^9
;;^UTILITY(U,$J,358.6,9,13,4,0)
;;=3;IBE(358.99,^^0^^^^^
;;^UTILITY(U,$J,358.6,9,13,5,0)
;;=4;IBD(358.98,^^1^^^^^10
;;^UTILITY(U,$J,358.6,9,13,6,0)
;;=5;IBD(358.98,^^1^^^^^11
;;^UTILITY(U,$J,358.6,9,13,7,0)
;;=6;IBD(358.98,^^1^^^^^12
;;^UTILITY(U,$J,358.6,9,13,8,0)
;;=7;IBD(358.98,^^1^^^^^5
;;^UTILITY(U,$J,358.6,9,13,9,0)
;;=8;IBD(358.98,^^1^^^^^6
;;^UTILITY(U,$J,358.6,9,13,10,0)
;;=9;IBD(358.98,^^1^^^^^6
;;^UTILITY(U,$J,358.6,9,14)
;;=S Y=$$DSPICD10^IBDFN9(Y)
;;^UTILITY(U,$J,358.6,9,16)
;;=^^^^^^^^
;;^UTILITY(U,$J,358.6,9,17)
;;=D SLCTDX10^IBDFN12(.X)
;;^UTILITY(U,$J,358.6,9,18)
;;=S IBDF("OTHER")="80^I '$P(^(0),U,9)" D LIST^IBDFDE2(.IBDSEL,.IBDF,"ICD-10 Diagnosis Code")
;;^UTILITY(U,$J,358.6,9,19)
;;=D DX10^IBDFN14(X)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDEI3JW 1095 printed Oct 16, 2024@18:50:58 Page 2
IBDEI3JW ; ; 19-NOV-2015
+1 ;;3.0;IB ENCOUNTER FORM IMP/EXP;;JUN 29, 2015
+2 if 'DIFQR(358.6)
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.6,9,13,3,0)
+2 ;;=3;IBD(358.98,^^1^^^^^9
+3 ;;^UTILITY(U,$J,358.6,9,13,4,0)
+4 ;;=3;IBE(358.99,^^0^^^^^
+5 ;;^UTILITY(U,$J,358.6,9,13,5,0)
+6 ;;=4;IBD(358.98,^^1^^^^^10
+7 ;;^UTILITY(U,$J,358.6,9,13,6,0)
+8 ;;=5;IBD(358.98,^^1^^^^^11
+9 ;;^UTILITY(U,$J,358.6,9,13,7,0)
+10 ;;=6;IBD(358.98,^^1^^^^^12
+11 ;;^UTILITY(U,$J,358.6,9,13,8,0)
+12 ;;=7;IBD(358.98,^^1^^^^^5
+13 ;;^UTILITY(U,$J,358.6,9,13,9,0)
+14 ;;=8;IBD(358.98,^^1^^^^^6
+15 ;;^UTILITY(U,$J,358.6,9,13,10,0)
+16 ;;=9;IBD(358.98,^^1^^^^^6
+17 ;;^UTILITY(U,$J,358.6,9,14)
+18 ;;=S Y=$$DSPICD10^IBDFN9(Y)
+19 ;;^UTILITY(U,$J,358.6,9,16)
+20 ;;=^^^^^^^^
+21 ;;^UTILITY(U,$J,358.6,9,17)
+22 ;;=D SLCTDX10^IBDFN12(.X)
+23 ;;^UTILITY(U,$J,358.6,9,18)
+24 ;;=S IBDF("OTHER")="80^I '$P(^(0),U,9)" D LIST^IBDFDE2(.IBDSEL,.IBDF,"ICD-10 Diagnosis Code")
+25 ;;^UTILITY(U,$J,358.6,9,19)
+26 ;;=D DX10^IBDFN14(X)
