IBINI0CW.m

IBINI0CW	; ; 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",1296,"DR",1,355.4)

	;;=4.06;4.07;4.08;4.09;

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

	;;=IB SCREEN3^2940201.1252^@^399^10882^@^2940318

	;;^UTILITY(U,$J,"DIE",1297,"DR",1,399)

	;;=S:$G(IBCNRTN) Y="@313" K IBCNRTN;S:IBDR20'["31" Y="@31";.07;S:'+$P(^IBE(350.9,1,1),U,22) Y="@314";.19;@314;S X=$P(^DGCR(399,DA,0),U,11);S Y="@"_$S(X']"":31,X="p":31,X="o":311,1:310);@310;

	;;^UTILITY(U,$J,"DIE",1297,"DR",1,399,1)

	;;=D 1^IBCSCH1 S Y="@"_$S(IBADI=-1:31,'IBADI:312,1:33);@313;@312;112;S:X="" Y="@999";113;S:X="" Y="@999";114;@999;S Y="@31";@311;D INST^IBCU;111;K DIC("DR"),DLAYGO;@31;S:IBDR20'["32" Y="@33";122;123;124;@33;S:IBDR20'["33" Y="@34";104;

	;;^UTILITY(U,$J,"DIE",1297,"DR",1,399,2)

	;;=105;106;S:X="" Y=107;121;107;108;109;@34;

	;;^UTILITY(U,$J,"DIE",1297,"ROU")

	;;=^IBXSC3

	;;^UTILITY(U,$J,"DIE",1297,"ROUOLD")

	;;=IBXSC3

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

	;;=IBDF EDIT AVAILABLE HLTH SMRY^2930924.1326^^357.6^^^^

	;;^UTILITY(U,$J,"DIE",1302,"%D",0)

	;;=^^1^1^2940308^

	;;^UTILITY(U,$J,"DIE",1302,"%D",1,0)

	;;=Used to define a package interface that prints a Health Summary.

	;;^UTILITY(U,$J,"DIE",1302,"DIAB",3,0,357.6,0)

	;;=1;REQ

	;;^UTILITY(U,$J,"DIE",1302,"DIAB",9,0,357.6,0)

	;;=.11;REQ

	;;^UTILITY(U,$J,"DIE",1302,"DIAB",10,0,357.6,0)

	;;=.09;REQ

	;;^UTILITY(U,$J,"DIE",1302,"DR",1,357.6)

	;;=.01;.06////4;1R~;3;.02///PRNTSMRY;.03///IBDFN5;.04////^S X="HEALTH SUMMARY";.1///YES;.11R~;.09R~;S IBDELETE=0;

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

	;;=IBT INS VERIFICATION^2940301.092^@^356.2^1453^@^2940315

	;;^UTILITY(U,$J,"DIE",1306,"DIAB",4,0,356.2,0)

	;;=TRACKING ID:

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

	;;=S DIE("NO^")="BACKOUTOK";.01;I $$TCODE^IBTRC(DA)'=85 S Y="@999";^356^IBT(356,^^S I(0,0)=D0 S Y(1)=$S($D(^IBT(356.2,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");1.05////^S X=$G(IBCDFN);

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

	;;=S IBTLST=$$LAST^IBTRC3($P(^IBT(356.2,DA,0),"^",2),DA);.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";.07//^S X=$$CP^IBTRC3(DA,$G(IBTLST));@170;.09;.28;11;

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

	;;=.19///^S X=10;@999;

	;;^UTILITY(U,$J,"DIE",1306,"DR",2,356)

	;;=.31;1.07;

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

	;;=IB SCREEN82^2931220.1227^@^399^10882^@^2940310

	;;^UTILITY(U,$J,"DIE",1316,"DIAB",7,0,399,0)

	;;=213;"ATTENDING PHYSICIAN ID"

	;;^UTILITY(U,$J,"DIE",1316,"DIAB",8,0,399,0)

	;;=214;"OTHER PHYSICIAN ID"

	;;^UTILITY(U,$J,"DIE",1316,"DR",1,399)

	;;=S:IBDR20'["81" Y="@82";208;163;215;@82;S:IBDR20'["82" Y="@83";213ATTENDING PHYSICIAN ID~;214OTHER PHYSICIAN ID~;@83;S:IBDR20'["83" Y="@84";450;451;@84;S:IBDR20'["84" Y="@85";452;453;454;455;@85;S:IBDR20'["85" Y="@86";456;457;458;

	;;^UTILITY(U,$J,"DIE",1316,"DR",1,399,1)

	;;=@86;

	;;^UTILITY(U,$J,"DIE",1316,"ROU")

	;;=^IBXSC82

	;;^UTILITY(U,$J,"DIE",1316,"ROUOLD")

	;;=IBXSC82

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

	;;=IBT QUICK EDIT^2940226.1407^@^356^1453^@^2940315

	;;^UTILITY(U,$J,"DIE",1327,"DR",1,356)

	;;=S IBTRTP=$$TRTP^IBTRE1(DA) I IBTRTP'=1 S Y="@10";.07;@10;.24;I 'X S Y="@20";1.07;.31;.14;I 'X S Y="@20";.15;@20;N IBX S IBX=$G(^IBT(356,DA,0)) I '$$INSURED^IBCNS1($P(IBX,U,2),$P(IBX,U,6)) S Y="@21";.19;I 'X S Y="@22";1.08;

	;;^UTILITY(U,$J,"DIE",1327,"DR",1,356,1)

	;;=S Y="@22";@21;.19///NOT INSURED;@22;I IBTRTP'=1!($G(IBTRPRF)'[1) S Y="@90";.25//NO;.26//NONE;.27//NO;@90;N X S X=$G(^IBT(356,DA,0)) I '$P(X,"^",25),'$P(X,"^",26),'$P(X,"^",27) S Y="@105";1.05;@105;

	;;^UTILITY(U,$J,"DIE",1327,"DR",1,356,2)

	;;=I '$P(^IBT(356,DA,0),U,24) S Y="@106";1.06;@106;I $G(IBTATRK) S Y="@999";I $P(^IBT(356,DA,0),U,19)!($G(IBTRPRF)'[3) S Y="@999";.12;.17;.21;.22;.23;.28;.29;@999;

IBINI0CW  ; ; 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",1296,"DR",1,355.4)

 +2       ;;=4.06;4.07;4.08;4.09;

 +3       ;;^UTILITY(U,$J,"DIE",1297,0)

 +4       ;;=IB SCREEN3^2940201.1252^@^399^10882^@^2940318

 +5       ;;^UTILITY(U,$J,"DIE",1297,"DR",1,399)

 +6       ;;=S:$G(IBCNRTN) Y="@313" K IBCNRTN;S:IBDR20'["31" Y="@31";.07;S:'+$P(^IBE(350.9,1,1),U,22) Y="@314";.19;@314;S X=$P(^DGCR(399,DA,0),U,11);S Y="@"_$S(X']"":31,X="p":31,X="o":311,1:310);@310;

 +7       ;;^UTILITY(U,$J,"DIE",1297,"DR",1,399,1)

 +8       ;;=D 1^IBCSCH1 S Y="@"_$S(IBADI=-1:31,'IBADI:312,1:33);@313;@312;112;S:X="" Y="@999";113;S:X="" Y="@999";114;@999;S Y="@31";@311;D INST^IBCU;111;K DIC("DR"),DLAYGO;@31;S:IBDR20'["32" Y="@33";122;123;124;@33;S:IBDR20'["33" Y="@34";104;

 +9       ;;^UTILITY(U,$J,"DIE",1297,"DR",1,399,2)

 +10      ;;=105;106;S:X="" Y=107;121;107;108;109;@34;

 +11      ;;^UTILITY(U,$J,"DIE",1297,"ROU")

 +12      ;;=^IBXSC3

 +13      ;;^UTILITY(U,$J,"DIE",1297,"ROUOLD")

 +14      ;;=IBXSC3

 +15      ;;^UTILITY(U,$J,"DIE",1302,0)

 +16      ;;=IBDF EDIT AVAILABLE HLTH SMRY^2930924.1326^^357.6^^^^

 +17      ;;^UTILITY(U,$J,"DIE",1302,"%D",0)

 +18      ;;=^^1^1^2940308^

 +19      ;;^UTILITY(U,$J,"DIE",1302,"%D",1,0)

 +20      ;;=Used to define a package interface that prints a Health Summary.

 +21      ;;^UTILITY(U,$J,"DIE",1302,"DIAB",3,0,357.6,0)

 +22      ;;=1;REQ

 +23      ;;^UTILITY(U,$J,"DIE",1302,"DIAB",9,0,357.6,0)

 +24      ;;=.11;REQ

 +25      ;;^UTILITY(U,$J,"DIE",1302,"DIAB",10,0,357.6,0)

 +26      ;;=.09;REQ

 +27      ;;^UTILITY(U,$J,"DIE",1302,"DR",1,357.6)

 +28      ;;=.01;.06////4;1R~;3;.02///PRNTSMRY;.03///IBDFN5;.04////^S X="HEALTH SUMMARY";.1///YES;.11R~;.09R~;S IBDELETE=0;

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

 +30      ;;=IBT INS VERIFICATION^2940301.092^@^356.2^1453^@^2940315

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

 +32      ;;=TRACKING ID:

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

 +34      ;;=S DIE("NO^")="BACKOUTOK";.01;I $$TCODE^IBTRC(DA)'=85 S Y="@999";^356^IBT(356,^^S I(0,0)=D0 S Y(1)=$S($D(^IBT(356.2,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S D(0)=+X S X=$S(D(0)>0:D(0),1:"");1.05////^S X=$G(IBCDFN);

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

 +36      ;;=S IBTLST=$$LAST^IBTRC3($P(^IBT(356.2,DA,0),"^",2),DA);.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";.07//^S X=$$CP^IBTRC3(DA,$G(IBTLST));@170;.09;.28;11;

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

 +38      ;;=.19///^S X=10;@999;

 +39      ;;^UTILITY(U,$J,"DIE",1306,"DR",2,356)

 +40      ;;=.31;1.07;

 +41      ;;^UTILITY(U,$J,"DIE",1316,0)

 +42      ;;=IB SCREEN82^2931220.1227^@^399^10882^@^2940310

 +43      ;;^UTILITY(U,$J,"DIE",1316,"DIAB",7,0,399,0)

 +44      ;;=213;"ATTENDING PHYSICIAN ID"

 +45      ;;^UTILITY(U,$J,"DIE",1316,"DIAB",8,0,399,0)

 +46      ;;=214;"OTHER PHYSICIAN ID"

 +47      ;;^UTILITY(U,$J,"DIE",1316,"DR",1,399)

 +48      ;;=S:IBDR20'["81" Y="@82";208;163;215;@82;S:IBDR20'["82" Y="@83";213ATTENDING PHYSICIAN ID~;214OTHER PHYSICIAN ID~;@83;S:IBDR20'["83" Y="@84";450;451;@84;S:IBDR20'["84" Y="@85";452;453;454;455;@85;S:IBDR20'["85" Y="@86";456;457;458;

 +49      ;;^UTILITY(U,$J,"DIE",1316,"DR",1,399,1)

 +50      ;;=@86;

 +51      ;;^UTILITY(U,$J,"DIE",1316,"ROU")

 +52      ;;=^IBXSC82

 +53      ;;^UTILITY(U,$J,"DIE",1316,"ROUOLD")

 +54      ;;=IBXSC82

 +55      ;;^UTILITY(U,$J,"DIE",1327,0)

 +56      ;;=IBT QUICK EDIT^2940226.1407^@^356^1453^@^2940315

 +57      ;;^UTILITY(U,$J,"DIE",1327,"DR",1,356)

 +58      ;;=S IBTRTP=$$TRTP^IBTRE1(DA) I IBTRTP'=1 S Y="@10";.07;@10;.24;I 'X S Y="@20";1.07;.31;.14;I 'X S Y="@20";.15;@20;N IBX S IBX=$G(^IBT(356,DA,0)) I '$$INSURED^IBCNS1($P(IBX,U,2),$P(IBX,U,6)) S Y="@21";.19;I 'X S Y="@22";1.08;

 +59      ;;^UTILITY(U,$J,"DIE",1327,"DR",1,356,1)

 +60      ;;=S Y="@22";@21;.19///NOT INSURED;@22;I IBTRTP'=1!($G(IBTRPRF)'[1) S Y="@90";.25//NO;.26//NONE;.27//NO;@90;N X S X=$G(^IBT(356,DA,0)) I '$P(X,"^",25),'$P(X,"^",26),'$P(X,"^",27) S Y="@105";1.05;@105;

 +61      ;;^UTILITY(U,$J,"DIE",1327,"DR",1,356,2)

 +62      ;;=I '$P(^IBT(356,DA,0),U,24) S Y="@106";1.06;@106;I $G(IBTATRK) S Y="@999";I $P(^IBT(356,DA,0),U,19)!($G(IBTRPRF)'[3) S Y="@999";.12;.17;.21;.22;.23;.28;.29;@999;