IBCNSU1.m

IBCNSU1	;ALB/AAS - INSURANCE UTILITY ROUTINE ; 19-MAY-93

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

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

	;

RCHK(X)	; -- Input transform for different revenue codes in file 36

	;    Returns 1 if passes, 0 if not pass input transform

	;

	N I,Y,RC,NO S Y=0

	I $G(X)="" G RCHKQ

	F I=1:1 S RC=$P(X,",",I) Q:RC=""  I $S(RC?3N:0,RC?5N:0,1:1) S NO=1 Q

	I '$G(NO) S Y=1

RCHKQ	Q Y

	;

BU(DFN,IBCPOL,IBYR,IBCDFN,IBASK)	; -- Return entry in Benefits Used file

	;     Input:  IBCDFN  = pointer to patient file policy (2.312)

	;             DFN     = patient pointer        

	;             IBCPOL  = pointer to health insurance policy file

	;             IBYR    = fileman internal date, year will be calendar

	;                       year of the internal date, Default = dt

	;             IBASK   = 1 if want to ask okay to add new entry

	;

	;    Output:  IBCBU   = pointer to Benefits Used file if added,

	;                       else null

	;

	N DIR,IBCBU

	S IBCBU=""

	I $G(IBCPOL)="" G BUQ

	I $G(IBYR)="" S IBYR=DT

	;

	;if no match display message

	I '$O(^IBA(355.4,"APY",IBCPOL,-IBYR,0)) W !!,"You cannot add a new Benefits Used BENEFIT YEAR",!! G BUQ

	;

	; -- try to find entry for policy for year

	S IBCBU=$O(^IBA(355.5,"APPY",DFN,IBCPOL,-IBYR,IBCDFN,0))

	;

	; -- if no match add new entry

	I 'IBCBU D

	.I $G(IBASK) S DIR(0)="Y",DIR("A")="Are you adding a new Benefits Used YEAR",DIR("B")="YES" D ^DIR I $D(DIRUT)!(Y<1) S VALMQUIT="" Q

	.S IBCBU=$$ADDBU(DFN,IBCPOL,IBYR,IBCDFN)

	.Q

	;

BUQ	Q IBCBU

	;

ADDBU(DFN,IBCPOL,IBYR,IBCDFN)	; -- add entries to Benefits Used file

	;     Input:  DFN     = pointer to patient file

	;             IBCDFN  = point to patient policy (2.312)

	;             IBCPOL  = pointer to health insurance policy file

	;             IBYR    = fileman internal date, year will be calendar

	;                       year of the internal date, Default = dt

	;

	;    Output:  IBCBU   = pointer to Benefits Used file if added,

	;                       else null

	;

	N %DT,IBN1,IBCBU,DIC,DIE,DR,DA,DLAYGO,DO,DD

	S IBCBU=""

	I $G(IBCDFN)="" G ADDBUQ

	I $G(IBCPOL)="" G ADDBUQ

	I $G(IBYR)="" S IBYR=DT

	K DD,DO,DIC,DR S DIC="^IBA(355.5,",DIC(0)="L",DLAYGO=355.5

	;

	;S IBYR=$E(IBYR,1,3)_"0000"

	S X=IBCPOL D FILE^DICN I +Y<0 G ADDBUQ

	S (IBCBU,DA)=+Y,DIE="^IBA(355.5,",DR=".02////"_DFN_";.03////"_IBYR_";.17////"_IBCDFN_";1.01///NOW;1.02////"_DUZ

	D ^DIE K DIC,DIE,DA,DR

ADDBUQ	Q IBCBU

IBCNSU1   ;ALB/AAS - INSURANCE UTILITY ROUTINE ; 19-MAY-93

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

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

 +3       ;

RCHK(X)   ; -- Input transform for different revenue codes in file 36

 +1       ;    Returns 1 if passes, 0 if not pass input transform

 +2       ;

 +3        NEW I,Y,RC,NO

           SET Y=0

 +4        IF $GET(X)=""

               GOTO RCHKQ

 +5        FOR I=1:1

               SET RC=$PIECE(X,",",I)

               IF RC=""

                   QUIT 

               IF $SELECT(RC?3N:0,RC?5N:0,1:1)

                   SET NO=1

                   QUIT 

 +6        IF '$GET(NO)

               SET Y=1

RCHKQ      QUIT Y

 +1       ;

BU(DFN,IBCPOL,IBYR,IBCDFN,IBASK) ; -- Return entry in Benefits Used file

 +1       ;     Input:  IBCDFN  = pointer to patient file policy (2.312)

 +2       ;             DFN     = patient pointer        

 +3       ;             IBCPOL  = pointer to health insurance policy file

 +4       ;             IBYR    = fileman internal date, year will be calendar

 +5       ;                       year of the internal date, Default = dt

 +6       ;             IBASK   = 1 if want to ask okay to add new entry

 +7       ;

 +8       ;    Output:  IBCBU   = pointer to Benefits Used file if added,

 +9       ;                       else null

 +10      ;

 +11       NEW DIR,IBCBU

 +12       SET IBCBU=""

 +13       IF $GET(IBCPOL)=""

               GOTO BUQ

 +14       IF $GET(IBYR)=""

               SET IBYR=DT

 +15      ;

 +16      ;if no match display message

 +17       IF '$ORDER(^IBA(355.4,"APY",IBCPOL,-IBYR,0))

               WRITE !!,"You cannot add a new Benefits Used BENEFIT YEAR",!!

               GOTO BUQ

 +18      ;

 +19      ; -- try to find entry for policy for year

 +20       SET IBCBU=$ORDER(^IBA(355.5,"APPY",DFN,IBCPOL,-IBYR,IBCDFN,0))

 +21      ;

 +22      ; -- if no match add new entry

 +23       IF 'IBCBU

               Begin DoDot:1

 +24               IF $GET(IBASK)

                       SET DIR(0)="Y"

                       SET DIR("A")="Are you adding a new Benefits Used YEAR"

                       SET DIR("B")="YES"

                       DO ^DIR

                       IF $DATA(DIRUT)!(Y<1)

                           SET VALMQUIT=""

                           QUIT 

 +25               SET IBCBU=$$ADDBU(DFN,IBCPOL,IBYR,IBCDFN)

 +26               QUIT 

               End DoDot:1

 +27      ;

BUQ        QUIT IBCBU

 +1       ;

ADDBU(DFN,IBCPOL,IBYR,IBCDFN) ; -- add entries to Benefits Used file

 +1       ;     Input:  DFN     = pointer to patient file

 +2       ;             IBCDFN  = point to patient policy (2.312)

 +3       ;             IBCPOL  = pointer to health insurance policy file

 +4       ;             IBYR    = fileman internal date, year will be calendar

 +5       ;                       year of the internal date, Default = dt

 +6       ;

 +7       ;    Output:  IBCBU   = pointer to Benefits Used file if added,

 +8       ;                       else null

 +9       ;

 +10       NEW %DT,IBN1,IBCBU,DIC,DIE,DR,DA,DLAYGO,DO,DD

 +11       SET IBCBU=""

 +12       IF $GET(IBCDFN)=""

               GOTO ADDBUQ

 +13       IF $GET(IBCPOL)=""

               GOTO ADDBUQ

 +14       IF $GET(IBYR)=""

               SET IBYR=DT

 +15       KILL DD,DO,DIC,DR

           SET DIC="^IBA(355.5,"

           SET DIC(0)="L"

           SET DLAYGO=355.5

 +16      ;

 +17      ;S IBYR=$E(IBYR,1,3)_"0000"

 +18       SET X=IBCPOL

           DO FILE^DICN

           IF +Y<0

               GOTO ADDBUQ

 +19       SET (IBCBU,DA)=+Y

           SET DIE="^IBA(355.5,"

           SET DR=".02////"_DFN_";.03////"_IBYR_";.17////"_IBCDFN_";1.01///NOW;1.02////"_DUZ

 +20       DO ^DIE

           KILL DIC,DIE,DA,DR

ADDBUQ     QUIT IBCBU