- 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
