- IBPF1 ;ALB/CPM - FIND BILLING DATA TO ARCHIVE (CON'T.) ; 20-APR-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- BILL ; Find all UB-82's which may be archived. Check only those bills
- ; whose First Printed Date is prior to the last date on which a
- ; bill must have been closed out in Accounts Receivable.
- ;
- ; Input: IBEDT -- last valid date on which a bill may be closed out
- ; IBTMPL -- search template in which to store entries
- ; Output: IBCNT -- number of IB Actions which may be archived.
- ;
- S (IBDT,IBN)="",IBCNT=0
- F S IBDT=$O(^DGCR(399,"AP",IBDT)) Q:'IBDT!(IBDT>IBEDT) F S IBN=$O(^DGCR(399,"AP",IBDT,IBN)) Q:'IBN I $$ALL(IBN,IBEDT) S IBCNT=IBCNT+1,^DIBT(IBTMPL,1,IBN)=""
- K IBCLO,IBDT,IBN
- Q
- ;
- ;
- IB ; Find Pharmacy Co-pay IB Actions which may be archived. Check
- ; only those Pharmacy Co-pay IB Actions which have been added to the
- ; database prior to the last date on which a bill must have been
- ; closed out in Accounts Receivable. Only "parent actions" will
- ; be checked, and if the parent action may be archived, the parent
- ; and its "children" will all be marked for archiving.
- ;
- ; Input: IBEDT -- last valid date on which a bill may be closed out
- ; IBTMPL -- search template in which to store entries
- ; Output: IBCNT -- number of IB Actions which may be archived.
- ;
- ; - first find all Pharmacy action types.
- K IBA F I=1:1 S IBATYPN=$P($T(PSO+I),";;",2,99) Q:IBATYPN="" S IBATYP=$O(^IBE(350.1,"B",IBATYPN,0)) I IBATYP S IBA(IBATYP)=""
- ;
- ; - locate all Pharmacy Co-pay actions which may be archived.
- S (IBDT,IBN)="",IBCNT=0
- F S IBDT=$O(^IB("D",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.3)) D
- . F S IBN=$O(^IB("D",IBDT,IBN)) Q:'IBN D:$D(^IB("AD",IBN))
- .. S IBND=$G(^IB(IBN,0)) Q:IBND="" ; 0th node missing
- .. Q:'$D(IBA(+$P(IBND,"^",3))) ; not a Pharmacy co-pay action
- .. Q:$$RXFILE(IBND) ; billed prescription has not been archived
- .. S IBAR=$P(IBND,"^",11) Q:IBAR=""
- .. S X="RCFN03" X ^%ZOSF("TEST")
- .. S IBAR=$S($T:$$BIEN^RCFN03(IBAR),1:$O(^PRCA(430,"B",IBAR,0)))
- .. Q:'IBAR S IBCLO=$$PUR^PRCAFN(IBAR) ; get date bill was closed
- .. I IBCLO>0,IBCLO'>IBEDT F DA=0:0 S DA=$O(^IB("AD",IBN,DA)) Q:'DA S IBCNT=IBCNT+1,^DIBT(IBTMPL,1,DA)=""
- ;
- ; - kill variables and quit.
- K DA,IBA,IBAR,IBATYP,IBATYPN,IBCLO,IBDT,IBN,IBND,X
- Q
- ;
- ;
- RXFILE(IBND) ; Is the prescription still resident on-line?
- ; Input: IBND -- zeroth node of IB Action
- ; Output: 1 -- the rx is still on file
- ; 0 -- the rx is no longer on file (archived)
- N IBSL
- S IBSL=$P(IBND,"^",4) I +IBSL'=52 Q 0
- I $D(^PSRX($P($P(IBSL,";"),":",2),0)) Q 1
- Q 0
- ;
- ALL(IBN,DATE) ; Are all bills for an episode of care closed before DATE?
- ; Input: IBN -- ien of bill in file #399
- ; DATE -- the date by which the bills must be closed
- ; Output: 1 -- all bills are closed
- ; 0 -- at least one bill is not closed
- N I,X
- S X=$$CLO(IBN,DATE)
- I X S I=0 F S I=$O(^DGCR(399,"AC",IBN,I)) Q:'I I I'=IBN,'$$CLO(I,DATE) S X=0 Q
- Q X
- ;
- CLO(IBN,DATE) ; Is the bill closed before DATE?
- ; Input: IBN -- ien of bill in file #399
- ; DATE -- the date by which the bill must be closed
- ; Output: 1 -- the bill is closed
- ; 0 -- the bill is not closed
- N CLO S CLO=$$PUR^PRCAFN(IBN)
- Q $S(CLO<0:0,1:CLO'>DATE)
- ;
- ;
- PSO ; Pharmacy Co-pay Action Types
- ;;PSO NSC RX COPAY CANCEL
- ;;PSO NSC RX COPAY NEW
- ;;PSO NSC RX COPAY UPDATE
- ;;PSO SC RX COPAY CANCEL
- ;;PSO SC RX COPAY NEW
- ;;PSO SC RX COPAY UPDATE
- ;
- IBPF1 ;ALB/CPM - FIND BILLING DATA TO ARCHIVE (CON'T.) ; 20-APR-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- BILL ; Find all UB-82's which may be archived. Check only those bills
- +1 ; whose First Printed Date is prior to the last date on which a
- +2 ; bill must have been closed out in Accounts Receivable.
- +3 ;
- +4 ; Input: IBEDT -- last valid date on which a bill may be closed out
- +5 ; IBTMPL -- search template in which to store entries
- +6 ; Output: IBCNT -- number of IB Actions which may be archived.
- +7 ;
- +8 SET (IBDT,IBN)=""
- SET IBCNT=0
- +9 FOR
- SET IBDT=$ORDER(^DGCR(399,"AP",IBDT))
- IF 'IBDT!(IBDT>IBEDT)
- QUIT
- FOR
- SET IBN=$ORDER(^DGCR(399,"AP",IBDT,IBN))
- IF 'IBN
- QUIT
- IF $$ALL(IBN,IBEDT)
- SET IBCNT=IBCNT+1
- SET ^DIBT(IBTMPL,1,IBN)=""
- +10 KILL IBCLO,IBDT,IBN
- +11 QUIT
- +12 ;
- +13 ;
- IB ; Find Pharmacy Co-pay IB Actions which may be archived. Check
- +1 ; only those Pharmacy Co-pay IB Actions which have been added to the
- +2 ; database prior to the last date on which a bill must have been
- +3 ; closed out in Accounts Receivable. Only "parent actions" will
- +4 ; be checked, and if the parent action may be archived, the parent
- +5 ; and its "children" will all be marked for archiving.
- +6 ;
- +7 ; Input: IBEDT -- last valid date on which a bill may be closed out
- +8 ; IBTMPL -- search template in which to store entries
- +9 ; Output: IBCNT -- number of IB Actions which may be archived.
- +10 ;
- +11 ; - first find all Pharmacy action types.
- +12 KILL IBA
- FOR I=1:1
- SET IBATYPN=$PIECE($TEXT(PSO+I),";;",2,99)
- IF IBATYPN=""
- QUIT
- SET IBATYP=$ORDER(^IBE(350.1,"B",IBATYPN,0))
- IF IBATYP
- SET IBA(IBATYP)=""
- +13 ;
- +14 ; - locate all Pharmacy Co-pay actions which may be archived.
- +15 SET (IBDT,IBN)=""
- SET IBCNT=0
- +16 FOR
- SET IBDT=$ORDER(^IB("D",IBDT))
- IF 'IBDT!(IBDT>(IBEDT+.3))
- QUIT
- Begin DoDot:1
- +17 FOR
- SET IBN=$ORDER(^IB("D",IBDT,IBN))
- IF 'IBN
- QUIT
- IF $DATA(^IB("AD",IBN))
- Begin DoDot:2
- +18 ; 0th node missing
- SET IBND=$GET(^IB(IBN,0))
- IF IBND=""
- QUIT
- +19 ; not a Pharmacy co-pay action
- IF '$DATA(IBA(+$PIECE(IBND,"^",3)))
- QUIT
- +20 ; billed prescription has not been archived
- IF $$RXFILE(IBND)
- QUIT
- +21 SET IBAR=$PIECE(IBND,"^",11)
- IF IBAR=""
- QUIT
- +22 SET X="RCFN03"
- XECUTE ^%ZOSF("TEST")
- +23 SET IBAR=$SELECT($TEST:$$BIEN^RCFN03(IBAR),1:$ORDER(^PRCA(430,"B",IBAR,0)))
- +24 ; get date bill was closed
- IF 'IBAR
- QUIT
- SET IBCLO=$$PUR^PRCAFN(IBAR)
- +25 IF IBCLO>0
- IF IBCLO'>IBEDT
- FOR DA=0:0
- SET DA=$ORDER(^IB("AD",IBN,DA))
- IF 'DA
- QUIT
- SET IBCNT=IBCNT+1
- SET ^DIBT(IBTMPL,1,DA)=""
- End DoDot:2
- End DoDot:1
- +26 ;
- +27 ; - kill variables and quit.
- +28 KILL DA,IBA,IBAR,IBATYP,IBATYPN,IBCLO,IBDT,IBN,IBND,X
- +29 QUIT
- +30 ;
- +31 ;
- RXFILE(IBND) ; Is the prescription still resident on-line?
- +1 ; Input: IBND -- zeroth node of IB Action
- +2 ; Output: 1 -- the rx is still on file
- +3 ; 0 -- the rx is no longer on file (archived)
- +4 NEW IBSL
- +5 SET IBSL=$PIECE(IBND,"^",4)
- IF +IBSL'=52
- QUIT 0
- +6 IF $DATA(^PSRX($PIECE($PIECE(IBSL,";"),":",2),0))
- QUIT 1
- +7 QUIT 0
- +8 ;
- ALL(IBN,DATE) ; Are all bills for an episode of care closed before DATE?
- +1 ; Input: IBN -- ien of bill in file #399
- +2 ; DATE -- the date by which the bills must be closed
- +3 ; Output: 1 -- all bills are closed
- +4 ; 0 -- at least one bill is not closed
- +5 NEW I,X
- +6 SET X=$$CLO(IBN,DATE)
- +7 IF X
- SET I=0
- FOR
- SET I=$ORDER(^DGCR(399,"AC",IBN,I))
- IF 'I
- QUIT
- IF I'=IBN
- IF '$$CLO(I,DATE)
- SET X=0
- QUIT
- +8 QUIT X
- +9 ;
- CLO(IBN,DATE) ; Is the bill closed before DATE?
- +1 ; Input: IBN -- ien of bill in file #399
- +2 ; DATE -- the date by which the bill must be closed
- +3 ; Output: 1 -- the bill is closed
- +4 ; 0 -- the bill is not closed
- +5 NEW CLO
- SET CLO=$$PUR^PRCAFN(IBN)
- +6 QUIT $SELECT(CLO<0:0,1:CLO'>DATE)
- +7 ;
- +8 ;
- PSO ; Pharmacy Co-pay Action Types
- +1 ;;PSO NSC RX COPAY CANCEL
- +2 ;;PSO NSC RX COPAY NEW
- +3 ;;PSO NSC RX COPAY UPDATE
- +4 ;;PSO SC RX COPAY CANCEL
- +5 ;;PSO SC RX COPAY NEW
- +6 ;;PSO SC RX COPAY UPDATE
- +7 ;
