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

IBINI0CW.m

Go to the documentation of this file.
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;