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;