IBINI0CT.m

IBINI0CT	; ; 21-MAR-1994

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	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,"DIE",1263,"DR",1,356.2,2)

	;;=@250;.17//^S X=$$MC^IBTRC3(DA,$G(IBTLST));I $P(^IBT(356.2,DA,0),U,17)'=1 S Y="@170";.07//^S X=$$CP^IBTRC3(DA,$G(IBTLST));@170;.09;I $$TCODE^IBTRC(DA)>30 S Y="@300";D HELP^IBTUTL3(DA);.11;

	;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,3)

	;;=N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S Y=$S(IBY:"@"_IBY,1:"@350");@10;1.08;I X S Y="@11";.12;.13;@11;.14;.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@300";@20;1.07;I X S Y="@21";.15;.16;@21;12;S Y="@300";

	;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,4)

	;;=@30;13;S Y="@300";@40;.2;S Y="@300";@50;.21;@300;@350;N IBTCOD S IBTCOD=$$TCODE^IBTRC(DA) S Y=$S(IBTCOD=50:"@355",IBTCOD=60:"@356",1:"@400");@355;.26;.11;

	;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,5)

	;;=N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S:IBY=20 Y="@400";.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@400";@356;.23;.1;I X'=3 S Y="@41";.29;I X=2 S Y="@42";.28;14;@41;.25;@42;

	;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,6)

	;;=I '$P(^IBT(356.2,DA,0),U,8) S Y="@400";^36^DIC(36,^^S I(0,0)=D0 S Y(1)=$S($D(^IBT(356.2,D0,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");@400;11;.19;.24;

	;;^UTILITY(U,$J,"DIE",1263,"DR",2,36)

	;;=.147;.141;.142;.143;.144;.145;.146;

	;;^UTILITY(U,$J,"DIE",1263,"DR",2,356.212)

	;;=.01

	;;^UTILITY(U,$J,"DIE",1263,"DR",2,356.213)

	;;=.01:.02

	;;^UTILITY(U,$J,"DIE",1263,"DR",2,356.214)

	;;=.01:.02

	;;^UTILITY(U,$J,"DIE",1264,0)

	;;=IBT COMMENT INFO^2930729.1247^@^356.2^1453^@^2940128

	;;^UTILITY(U,$J,"DIE",1264,"DR",1,356.2)

	;;=11;

	;;^UTILITY(U,$J,"DIE",1265,0)

	;;=IBT CONTACT INFO^2931006.154^@^356.2^1453^@^2931006

	;;^UTILITY(U,$J,"DIE",1265,"DR",1,356.2)

	;;=S IBTLST=$$LAST^IBTRC3($P(^IBT(356.2,DA,0),"^",2),DA);.01;I $P(^IBT(356.2,DA,0),U,2) S Y="@200";.05;@200;.06//^S X=$$PC^IBTRC3(DA,$G(IBTLST));.17//^S X=$$MC^IBTRC3(DA,$G(IBTLST));I $P(^IBT(356.2,DA,0),U,17)'=1 S Y="@170";

	;;^UTILITY(U,$J,"DIE",1265,"DR",1,356.2,1)

	;;=.07//^S X=$$CP^IBTRC3(DA,$G(IBTLST));@170;.09;

	;;^UTILITY(U,$J,"DIE",1266,0)

	;;=IBT INSURANCE INFO^2940216.1138^@^356.2^1453^@^2940226

	;;^UTILITY(U,$J,"DIE",1266,"DIAB",1,0,356.2,1)

	;;=.08:

	;;^UTILITY(U,$J,"DIE",1266,"DR",1,356.2)

	;;=1.05;W !!,"You are now editing the Insurance Company: ",!,$P($G(^DIC(36,+$P(^IBT(356.2,DA,0),"^",8),0)),"^"),!!;

	;;^UTILITY(U,$J,"DIE",1266,"DR",1,356.2,1)

	;;=^36^DIC(36,^^S I(0,0)=D0 S Y(1)=$S($D(^IBT(356.2,D0,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");

	;;^UTILITY(U,$J,"DIE",1266,"DR",2,36)

	;;=.131;.132;.133;.134;.135;.136;.137;.138;

	;;^UTILITY(U,$J,"DIE",1267,0)

	;;=IBT ACTION INFO^2940207.0926^@^356.2^1453^@^2940226

	;;^UTILITY(U,$J,"DIE",1267,"DIAB",1,1,356.212,0)

	;;=ALL

	;;^UTILITY(U,$J,"DIE",1267,"DIAB",1,1,356.213,0)

	;;=ALL

	;;^UTILITY(U,$J,"DIE",1267,"DIAB",1,1,356.214,0)

	;;=ALL

	;;^UTILITY(U,$J,"DIE",1267,"DR",1,356.2)

	;;=S IBTLST=$$LAST^IBTRC3($P(^IBT(356.2,DA,0),"^",2),DA);.04;I $$TCODE^IBTRC(DA)>30 S Y="@300";D HELP^IBTUTL3(DA);.11;N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S Y=$S(IBY:"@"_IBY,1:"@350");@10;1.08;

	;;^UTILITY(U,$J,"DIE",1267,"DR",1,356.2,1)

	;;=I X S Y="@11";.12;.13;@11;.14;.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@300";@20;1.07;I X S Y="@21";.15;.16;@21;12;S Y="@300";@30;13;S Y="@300";@40;.2;S Y="@300";@50;.21;@300;@350;

	;;^UTILITY(U,$J,"DIE",1267,"DR",1,356.2,2)

	;;=N IBTCOD S IBTCOD=$$TCODE^IBTRC(DA) S Y=$S(IBTCOD=50:"@355",IBTCOD=60:"@356",1:"@400");@355;.26;.11;N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S:IBY=20 Y="@400";.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@400";

IBINI0CT  ; ; 21-MAR-1994

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2        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,"DIE",1263,"DR",1,356.2,2)

 +2       ;;=@250;.17//^S X=$$MC^IBTRC3(DA,$G(IBTLST));I $P(^IBT(356.2,DA,0),U,17)'=1 S Y="@170";.07//^S X=$$CP^IBTRC3(DA,$G(IBTLST));@170;.09;I $$TCODE^IBTRC(DA)>30 S Y="@300";D HELP^IBTUTL3(DA);.11;

 +3       ;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,3)

 +4       ;;=N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S Y=$S(IBY:"@"_IBY,1:"@350");@10;1.08;I X S Y="@11";.12;.13;@11;.14;.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@300";@20;1.07;I X S Y="@21";.15;.16;@21;12;S Y="@300";

 +5       ;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,4)

 +6       ;;=@30;13;S Y="@300";@40;.2;S Y="@300";@50;.21;@300;@350;N IBTCOD S IBTCOD=$$TCODE^IBTRC(DA) S Y=$S(IBTCOD=50:"@355",IBTCOD=60:"@356",1:"@400");@355;.26;.11;

 +7       ;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,5)

 +8       ;;=N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S:IBY=20 Y="@400";.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@400";@356;.23;.1;I X'=3 S Y="@41";.29;I X=2 S Y="@42";.28;14;@41;.25;@42;

 +9       ;;^UTILITY(U,$J,"DIE",1263,"DR",1,356.2,6)

 +10      ;;=I '$P(^IBT(356.2,DA,0),U,8) S Y="@400";^36^DIC(36,^^S I(0,0)=D0 S Y(1)=$S($D(^IBT(356.2,D0,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");@400;11;.19;.24;

 +11      ;;^UTILITY(U,$J,"DIE",1263,"DR",2,36)

 +12      ;;=.147;.141;.142;.143;.144;.145;.146;

 +13      ;;^UTILITY(U,$J,"DIE",1263,"DR",2,356.212)

 +14      ;;=.01

 +15      ;;^UTILITY(U,$J,"DIE",1263,"DR",2,356.213)

 +16      ;;=.01:.02

 +17      ;;^UTILITY(U,$J,"DIE",1263,"DR",2,356.214)

 +18      ;;=.01:.02

 +19      ;;^UTILITY(U,$J,"DIE",1264,0)

 +20      ;;=IBT COMMENT INFO^2930729.1247^@^356.2^1453^@^2940128

 +21      ;;^UTILITY(U,$J,"DIE",1264,"DR",1,356.2)

 +22      ;;=11;

 +23      ;;^UTILITY(U,$J,"DIE",1265,0)

 +24      ;;=IBT CONTACT INFO^2931006.154^@^356.2^1453^@^2931006

 +25      ;;^UTILITY(U,$J,"DIE",1265,"DR",1,356.2)

 +26      ;;=S IBTLST=$$LAST^IBTRC3($P(^IBT(356.2,DA,0),"^",2),DA);.01;I $P(^IBT(356.2,DA,0),U,2) S Y="@200";.05;@200;.06//^S X=$$PC^IBTRC3(DA,$G(IBTLST));.17//^S X=$$MC^IBTRC3(DA,$G(IBTLST));I $P(^IBT(356.2,DA,0),U,17)'=1 S Y="@170";

 +27      ;;^UTILITY(U,$J,"DIE",1265,"DR",1,356.2,1)

 +28      ;;=.07//^S X=$$CP^IBTRC3(DA,$G(IBTLST));@170;.09;

 +29      ;;^UTILITY(U,$J,"DIE",1266,0)

 +30      ;;=IBT INSURANCE INFO^2940216.1138^@^356.2^1453^@^2940226

 +31      ;;^UTILITY(U,$J,"DIE",1266,"DIAB",1,0,356.2,1)

 +32      ;;=.08:

 +33      ;;^UTILITY(U,$J,"DIE",1266,"DR",1,356.2)

 +34      ;;=1.05;W !!,"You are now editing the Insurance Company: ",!,$P($G(^DIC(36,+$P(^IBT(356.2,DA,0),"^",8),0)),"^"),!!;

 +35      ;;^UTILITY(U,$J,"DIE",1266,"DR",1,356.2,1)

 +36      ;;=^36^DIC(36,^^S I(0,0)=D0 S Y(1)=$S($D(^IBT(356.2,D0,0)):^(0),1:"") S X=$P(Y(1),U,8),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");

 +37      ;;^UTILITY(U,$J,"DIE",1266,"DR",2,36)

 +38      ;;=.131;.132;.133;.134;.135;.136;.137;.138;

 +39      ;;^UTILITY(U,$J,"DIE",1267,0)

 +40      ;;=IBT ACTION INFO^2940207.0926^@^356.2^1453^@^2940226

 +41      ;;^UTILITY(U,$J,"DIE",1267,"DIAB",1,1,356.212,0)

 +42      ;;=ALL

 +43      ;;^UTILITY(U,$J,"DIE",1267,"DIAB",1,1,356.213,0)

 +44      ;;=ALL

 +45      ;;^UTILITY(U,$J,"DIE",1267,"DIAB",1,1,356.214,0)

 +46      ;;=ALL

 +47      ;;^UTILITY(U,$J,"DIE",1267,"DR",1,356.2)

 +48      ;;=S IBTLST=$$LAST^IBTRC3($P(^IBT(356.2,DA,0),"^",2),DA);.04;I $$TCODE^IBTRC(DA)>30 S Y="@300";D HELP^IBTUTL3(DA);.11;N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S Y=$S(IBY:"@"_IBY,1:"@350");@10;1.08;

 +49      ;;^UTILITY(U,$J,"DIE",1267,"DR",1,356.2,1)

 +50      ;;=I X S Y="@11";.12;.13;@11;.14;.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@300";@20;1.07;I X S Y="@21";.15;.16;@21;12;S Y="@300";@30;13;S Y="@300";@40;.2;S Y="@300";@50;.21;@300;@350;

 +51      ;;^UTILITY(U,$J,"DIE",1267,"DR",1,356.2,2)

 +52      ;;=N IBTCOD S IBTCOD=$$TCODE^IBTRC(DA) S Y=$S(IBTCOD=50:"@355",IBTCOD=60:"@356",1:"@400");@355;.26;.11;N IBY S IBY=$P($G(^IBE(356.7,+$P(^IBT(356.2,DA,0),U,11),0)),U,3) S:IBY=20 Y="@400";.28//^S X=$$AN^IBTRC3(DA,$G(IBTLST));S Y="@400";