- IBRFN1 ;ALB/CPM - PASS PATIENT STATEMENT DATA TO A/R ; 24-FEB-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- STMT(TRAN) ; Pass clinical data to AR for the patient statement.
- ; Input: TRAN -- AR Transaction number (ptr to #433)
- ; Returns: ^TMP("IBRFN1",$J,n)=1^2^3^4^5^6^7^8 , where
- ;
- ; -----------------------------------------------------------
- ; | | Transaction Type |
- ; |----------|------------------------------------------------|
- ; | Piece | Pharmacy | Outpatient | Inpatient |
- ; |----------|----------------|--------------|----------------|
- ; | 1 | IB Ref# | IB Ref# | IB Ref# |
- ; | 2 | Rx# | Visit Date | Adm Date |
- ; | 3 | Drug | -- | Bill From Date |
- ; | 4 | Days Supply | -- | Bill To Date |
- ; | 5 | Physician | -- | Disc Date |
- ; | 6 | Quantity | -- | -- |
- ; | 7 |Fill/Refill Date| -- | -- |
- ; | 8 | Charge Amt | Charge Amt | Charge Amt |
- ; -----------------------------------------------------------
- ;
- Q:'$G(TRAN) K ^TMP("IBRFN1",$J)
- N IBN,IBJ,IBND,IBBG,IBSL,IBPE
- S IBN=0 F IBJ=1:1 S IBN=$O(^IB("AT",TRAN,IBN)) Q:'IBN D
- . S IBND=$G(^IB(IBN,0)),IBSL=$P(IBND,"^",4),IBCHG=$P(IBND,"^",7) Q:'IBND
- . I +IBSL=52 D RX Q
- . S IBBG=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",11)
- . I IBBG=4 S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_$P(IBND,"^",14)_"^^^^^^"_IBCHG Q
- . S IBPE=$G(^IB(+$P(IBND,"^",16),0)) S:+IBSL'=405 IBSL=$P(IBPE,"^",4)
- . I +IBSL=405 D INP Q
- . S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^^"_$P(IBND,"^",14)_"^"_$P(IBND,"^",15)_"^^^^"_IBCHG
- Q
- ;
- RX ; Build array element for Pharmacy Co-pay charges.
- N %DT,I,IBRX,IBFILL,PSOFILL,PSONTALK,PSORX0,PSORX1,PSORXN,PSOTMP,VA,VAERR,X,Y,Z
- S IBRX=$P($P(IBSL,";"),":",2),IBFILL=+$P($P(IBSL,";",2),":",2)
- S X=IBRX_"^"_IBFILL,PSONTALK="" D EN^PSOCPVW
- S Z=+IBND F I=.01,6,8,4,7,22 S Z=Z_"^"_$G(PSOTMP(52,IBRX,I,"E"))
- S:IBFILL $P(Z,"^",7)=$G(PSOTMP(52.1,IBFILL,.01,"E"))
- S X=$P(Z,"^",7),%DT="" D ^%DT S $P(Z,"^",7)=$S(Y>0:Y,1:"")
- S ^TMP("IBRFN1",$J,IBJ)=Z_"^"_IBCHG
- Q
- ;
- INP ; Build array element for inpatient charges.
- N IBADM,IBDIS,IBFR,IBTO,PM,PM0,X,X1,X2
- S PM=+$P(IBSL,":",2),PM0=$G(^DGPM(PM,0))
- S IBADM=$S(PM0:+PM0\1,1:$P(IBPE,"^",17))
- S IBDIS=$S(PM0:$S($D(^DGPM(+$P(PM0,"^",17),0)):+^(0)\1,1:""),1:"")
- S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)
- ; - check for per diems added through C/E/A which are off by one day
- I IBBG=3 S X1=IBTO,X2=IBFR D ^%DTC I X+1'=$P(IBND,"^",6) S X1=IBTO,X2=-1 D C^%DTC S IBTO=X
- S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_IBADM_"^"_IBFR_"^"_IBTO_"^"_IBDIS_"^^^"_IBCHG
- Q
- IBRFN1 ;ALB/CPM - PASS PATIENT STATEMENT DATA TO A/R ; 24-FEB-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- STMT(TRAN) ; Pass clinical data to AR for the patient statement.
- +1 ; Input: TRAN -- AR Transaction number (ptr to #433)
- +2 ; Returns: ^TMP("IBRFN1",$J,n)=1^2^3^4^5^6^7^8 , where
- +3 ;
- +4 ; -----------------------------------------------------------
- +5 ; | | Transaction Type |
- +6 ; |----------|------------------------------------------------|
- +7 ; | Piece | Pharmacy | Outpatient | Inpatient |
- +8 ; |----------|----------------|--------------|----------------|
- +9 ; | 1 | IB Ref# | IB Ref# | IB Ref# |
- +10 ; | 2 | Rx# | Visit Date | Adm Date |
- +11 ; | 3 | Drug | -- | Bill From Date |
- +12 ; | 4 | Days Supply | -- | Bill To Date |
- +13 ; | 5 | Physician | -- | Disc Date |
- +14 ; | 6 | Quantity | -- | -- |
- +15 ; | 7 |Fill/Refill Date| -- | -- |
- +16 ; | 8 | Charge Amt | Charge Amt | Charge Amt |
- +17 ; -----------------------------------------------------------
- +18 ;
- +19 IF '$GET(TRAN)
- QUIT
- KILL ^TMP("IBRFN1",$JOB)
- +20 NEW IBN,IBJ,IBND,IBBG,IBSL,IBPE
- +21 SET IBN=0
- FOR IBJ=1:1
- SET IBN=$ORDER(^IB("AT",TRAN,IBN))
- IF 'IBN
- QUIT
- Begin DoDot:1
- +22 SET IBND=$GET(^IB(IBN,0))
- SET IBSL=$PIECE(IBND,"^",4)
- SET IBCHG=$PIECE(IBND,"^",7)
- IF 'IBND
- QUIT
- +23 IF +IBSL=52
- DO RX
- QUIT
- +24 SET IBBG=$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^",11)
- +25 IF IBBG=4
- SET ^TMP("IBRFN1",$JOB,IBJ)=+IBND_"^"_$PIECE(IBND,"^",14)_"^^^^^^"_IBCHG
- QUIT
- +26 SET IBPE=$GET(^IB(+$PIECE(IBND,"^",16),0))
- IF +IBSL'=405
- SET IBSL=$PIECE(IBPE,"^",4)
- +27 IF +IBSL=405
- DO INP
- QUIT
- +28 SET ^TMP("IBRFN1",$JOB,IBJ)=+IBND_"^^"_$PIECE(IBND,"^",14)_"^"_$PIECE(IBND,"^",15)_"^^^^"_IBCHG
- End DoDot:1
- +29 QUIT
- +30 ;
- RX ; Build array element for Pharmacy Co-pay charges.
- +1 NEW %DT,I,IBRX,IBFILL,PSOFILL,PSONTALK,PSORX0,PSORX1,PSORXN,PSOTMP,VA,VAERR,X,Y,Z
- +2 SET IBRX=$PIECE($PIECE(IBSL,";"),":",2)
- SET IBFILL=+$PIECE($PIECE(IBSL,";",2),":",2)
- +3 SET X=IBRX_"^"_IBFILL
- SET PSONTALK=""
- DO EN^PSOCPVW
- +4 SET Z=+IBND
- FOR I=.01,6,8,4,7,22
- SET Z=Z_"^"_$GET(PSOTMP(52,IBRX,I,"E"))
- +5 IF IBFILL
- SET $PIECE(Z,"^",7)=$GET(PSOTMP(52.1,IBFILL,.01,"E"))
- +6 SET X=$PIECE(Z,"^",7)
- SET %DT=""
- DO ^%DT
- SET $PIECE(Z,"^",7)=$SELECT(Y>0:Y,1:"")
- +7 SET ^TMP("IBRFN1",$JOB,IBJ)=Z_"^"_IBCHG
- +8 QUIT
- +9 ;
- INP ; Build array element for inpatient charges.
- +1 NEW IBADM,IBDIS,IBFR,IBTO,PM,PM0,X,X1,X2
- +2 SET PM=+$PIECE(IBSL,":",2)
- SET PM0=$GET(^DGPM(PM,0))
- +3 SET IBADM=$SELECT(PM0:+PM0\1,1:$PIECE(IBPE,"^",17))
- +4 SET IBDIS=$SELECT(PM0:$SELECT($DATA(^DGPM(+$PIECE(PM0,"^",17),0)):+^(0)\1,1:""),1:"")
- +5 SET IBFR=$PIECE(IBND,"^",14)
- SET IBTO=$PIECE(IBND,"^",15)
- +6 ; - check for per diems added through C/E/A which are off by one day
- +7 IF IBBG=3
- SET X1=IBTO
- SET X2=IBFR
- DO ^%DTC
- IF X+1'=$PIECE(IBND,"^",6)
- SET X1=IBTO
- SET X2=-1
- DO C^%DTC
- SET IBTO=X
- +8 SET ^TMP("IBRFN1",$JOB,IBJ)=+IBND_"^"_IBADM_"^"_IBFR_"^"_IBTO_"^"_IBDIS_"^^^"_IBCHG
- +9 QUIT
