IBCNSBL.m

IBCNSBL	;ALB/AAS - NEW INSURANCE POLICY BULLETIN ; 29-AUG-93

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

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

%	N IBP,START,END,X,Y,I,J,VAIN,VAINDT,VA,DA,DR,DIE,DIC,INPT,OPT,DGPM,IBINS,IBX,IBTADD

	;  

	Q:'$D(IBEVTA)!('$D(IBEVT1))!('$D(IBCDFN))

	;

	S IBP=$$PT^IBEFUNC(DFN),(OPT,INPT)=0

	;

	; -- set starting date = latest of jan 1 of prior year, or effective date,

	S START=$E(DT,1,3)-1,START=START_"0101"

	I $P(IBEVTA,"^",8),$P(IBEVTA,"^",8)>START S START=$P(IBEVTA,"^",8)

	;

	S END=DT+.9

	;

	S X=$O(^DPT(DFN,"S",START)) I X,(X'>(END+.24)) S OPT=1

	S X=$O(^DGPM("APTT1",DFN,START)) I X,(X'>(END+.24)) S INPT=1

	I $G(^DPT(DFN,.1))'="" D  S INPT=1

	.;

	.;see if current admission is in claims tracking

	.S VAINDT=DT+.24 D INP^VADPT

	.N IBMVAD,IBTRKR,IBRANDOM,DGPMA

	.S IBMVAD=+VAIN(1),DGPMA=$G(^DGPM(+IBMVAD,0))

	.I DFN=$P($G(^IBT(356,+$O(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2) Q  ; quit if already in claims tracking

	.S IBTRKR=$G(^IBE(350.9,1,6))

	.I $P(IBTRKR,"^",2)=2 D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=1

	.I $P(IBTRKR,"^",2)=1,$$INSURED^IBCNS1(DFN,+DGPMA) D ADM^IBTUTL(IBMVAD,$E(+DGPMA,1,12),0,$P(DGPMA,"^",27)) S IBTADD=1

	.Q

	;

	S VAINDT=START+.24 D INP^VADPT I $G(VAIN(1)) S INPT=1

	I 'OPT,'INPT G BQ

	;

	D BULL^IBCNSBL1

BQ	Q

IBCNSBL   ;ALB/AAS - NEW INSURANCE POLICY BULLETIN ; 29-AUG-93

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

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

%          NEW IBP,START,END,X,Y,I,J,VAIN,VAINDT,VA,DA,DR,DIE,DIC,INPT,OPT,DGPM,IBINS,IBX,IBTADD

 +1       ;  

 +2        IF '$DATA(IBEVTA)!('$DATA(IBEVT1))!('$DATA(IBCDFN))

               QUIT 

 +3       ;

 +4        SET IBP=$$PT^IBEFUNC(DFN)

           SET (OPT,INPT)=0

 +5       ;

 +6       ; -- set starting date = latest of jan 1 of prior year, or effective date,

 +7        SET START=$EXTRACT(DT,1,3)-1

           SET START=START_"0101"

 +8        IF $PIECE(IBEVTA,"^",8)

               IF $PIECE(IBEVTA,"^",8)>START

                   SET START=$PIECE(IBEVTA,"^",8)

 +9       ;

 +10       SET END=DT+.9

 +11      ;

 +12       SET X=$ORDER(^DPT(DFN,"S",START))

           IF X

               IF (X'>(END+.24))

                   SET OPT=1

 +13       SET X=$ORDER(^DGPM("APTT1",DFN,START))

           IF X

               IF (X'>(END+.24))

                   SET INPT=1

 +14       IF $GET(^DPT(DFN,.1))'=""

               Begin DoDot:1

 +15      ;

 +16      ;see if current admission is in claims tracking

 +17               SET VAINDT=DT+.24

                   DO INP^VADPT

 +18               NEW IBMVAD,IBTRKR,IBRANDOM,DGPMA

 +19               SET IBMVAD=+VAIN(1)

                   SET DGPMA=$GET(^DGPM(+IBMVAD,0))

 +20      ; quit if already in claims tracking

                   IF DFN=$PIECE($GET(^IBT(356,+$ORDER(^IBT(356,"AD",+IBMVAD,0)),0)),"^",2)

                       QUIT 

 +21               SET IBTRKR=$GET(^IBE(350.9,1,6))

 +22               IF $PIECE(IBTRKR,"^",2)=2

                       DO ADM^IBTUTL(IBMVAD,$EXTRACT(+DGPMA,1,12),0,$PIECE(DGPMA,"^",27))

                       SET IBTADD=1

 +23               IF $PIECE(IBTRKR,"^",2)=1

                       IF $$INSURED^IBCNS1(DFN,+DGPMA)

                           DO ADM^IBTUTL(IBMVAD,$EXTRACT(+DGPMA,1,12),0,$PIECE(DGPMA,"^",27))

                           SET IBTADD=1

 +24               QUIT 

               End DoDot:1

               SET INPT=1

 +25      ;

 +26       SET VAINDT=START+.24

           DO INP^VADPT

           IF $GET(VAIN(1))

               SET INPT=1

 +27       IF 'OPT

               IF 'INPT

                   GOTO BQ

 +28      ;

 +29       DO BULL^IBCNSBL1

BQ         QUIT