ABSPER20 ; IHS/FCS/DRS - Payable claims report ; [ 09/12/2002 10:01 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Pharmacy Claim Payable Report (by Tran Date, Sorted by Insurer)
;----------------------------------------------------------------------
EN ; option ABSP PAYABLE REPORT
N SCRNTXT,SDATE,EDATE,ANS,XBRP,J,XBNS,RPTNAME,PREFIXES
;
D DT^DICRW
D HOME^%ZIS
;
S RPTNAME="RX Payable RPT"
S SCRNTXT="Pharmacy Claim Payable Report (by Transmission Date)"
D WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
W !
;
S PREFIXES=$$PREFIXES^ABSPER10 Q:"^"[PREFIXES ; report which claims?
;
;Start Date Prompt
S (SDATE,EDATE)=""
LP1 S ANS=$$DATE^ABSPOSU1("Transmission - Start Date: ",SDATE,1,"","DT","E",DTIME)
G:ANS=-1!(ANS="^")!(ANS="^^")!(ANS="") EXIT
S SDATE=ANS
;
;End Date Prompt
LP2 S ANS=$$DATE^ABSPOSU1("Transmission - End Date: ",EDATE,1,SDATE,"DT","E",DTIME)
I ANS="^" D WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM) G LP1
G:ANS=-1!(ANS="^^")!(ANS="") EXIT
S EDATE=ANS
;
S XBRP="RPT^ABSPER20"
F J="SDATE","EDATE","SCRNTXT","RPTNAME","PREFIXES" S XBNS(J)=""
D ^XBDBQUE
EXIT Q
;----------------------------------------------------------------------
RPT N PAGE
U IO
K ^TMP($J,RPTNAME)
D SET
D PRINT^ABSPER2A
D ^%ZISC
K ^TMP($J,RPTNAME)
Q
;----------------------------------------------------------------------
SET N DATE1,DATE2,TDATE,RESPIEN,MEDIEN,CLAIMIEN,DATA,CLAIMID,INSIEN
N INSNAME,INSHELP,BITEMIEN,PCN,PATNAME,NDC
N INGRPD,DISPPD,TOTPD,PATPAY,REMDED,PSIEN S PSIEN=1
;
S DATE1=$$CDTFM^ABSPOSU1(SDATE,-1)_".245959"
S DATE2=EDATE_".245959"
K ^TMP($J,RPTNAME)
Q:IOM<132
;
;Loop through "AE" x-ref and gather responses within date range
S TDATE=DATE1
F D Q:TDATE=""!(TDATE>DATE2)
.S TDATE=$O(^ABSPR("AE",TDATE))
.Q:TDATE=""!(TDATE>DATE2)
.S RESPIEN=0
.F D Q:'+RESPIEN
..S RESPIEN=$O(^ABSPR("AE",TDATE,RESPIEN))
..Q:'+RESPIEN
..;Determine if response has paid items
..Q:'$D(^ABSPR("AC","P",RESPIEN))
..;Loop through payable index and get medication records
..S MEDIEN=0
..F D Q:'MEDIEN
...S MEDIEN=$O(^ABSPR("AC","P",RESPIEN,MEDIEN))
...Q:'+MEDIEN
...;Get needed data from 9002313.02 file
...S CLAIMIEN=$P($G(^ABSPR(RESPIEN,0)),U,1)
...Q:CLAIMIEN=""
...Q:'$D(^ABSPC(CLAIMIEN,0))
...S DATA=$G(^ABSPC(CLAIMIEN,0))
...S CLAIMID=$P(DATA,U,1)
...I PREFIXES]"",PREFIXES'[$E(CLAIMID) Q ; but do we want this claim?
...S INSIEN=$P(DATA,U,2)
...Q:'+INSIEN
...S INSNAME=$P($G(^AUTNINS(INSIEN,0)),U,1)
...Q:INSNAME=""
...S INSHELP=$$INSHELP^ABSPER10(INSIEN)
...S BITEMIEN=$P(DATA,U,3)
...S PCN=$S(BITEMIEN="":"",$P($G(^ABSP(9002313.99,+$G(PSIEN),2)),U,1)="VCN":$P($G(^ABSBITMS(9002302,BITEMIEN,"VCN")),U,1),1:$P($G(^ABSBITMS(9002302,BITEMIEN,0)),U,1)) ;either PCN or VCN displays
...I PCN="" S PCN="RX# "_$$RXNUM
...S PATNAME=$P($G(^ABSPC(CLAIMIEN,1)),U,1)
...S DATA=$G(^ABSPC(CLAIMIEN,400,MEDIEN,400))
...S NDC=$P(DATA,U,7)
...;Get and format fields from 9002313.03 for Medication record
...S DATA=$G(^ABSPR(RESPIEN,1000,MEDIEN,500))
...; But if the claim has been successfully reversed, rig $ fields
...I $$REVERSED(RESPIEN,MEDIEN) D
....S (INGRPD,DISPPD,PATPAY,REMDED)=""
....S TOTPD="REVERSED"
...E D
....S INGRPD=$J($$DFF2EXT^ABSPECFM($P(DATA,U,6)),7,2)
....S DISPPD=$J($$DFF2EXT^ABSPECFM($P(DATA,U,7)),7,2)
....S TOTPD=$J($$DFF2EXT^ABSPECFM($P(DATA,U,9)),9,2)
....S PATPAY=$J($$DFF2EXT^ABSPECFM($P(DATA,U,5)),9,2)
....S REMDED=$J($$DFF2EXT^ABSPECFM($P(DATA,U,13)),11,2)
...S ^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN)=CLAIMID_U_PCN_U_PATNAME_U_NDC_U_INGRPD_U_DISPPD_U_TOTPD_U_PATPAY_U_REMDED
...S ^TMP($J,RPTNAME,INSNAME)=INSHELP
Q
RXNUM() ;EP - from ABSPER10,ABSPER30
; try to return external #; try to append refill # if nonzero
; given CLAIMIEN, MEDIEN pointers into ^ABSPC
N X S X=+$P($G(^ABSPC(CLAIMIEN,400,MEDIEN,400)),U,2)
I 'X Q ""
I $D(^PSRX(X)) S X=$P(^PSRX(X,0),U)
E S X="`"_X
N Y S Y=+$P($G(^ABSPC(CLAIMIEN,400,MEDIEN,400)),U,3)
I Y S X=X_"r"_+Y
Q X
REVERSED(RESPIEN,MEDIEN) ; $$ = 1 if yes, = 0 if no
; It would be nice to use the numbering scheme - of attaching "R"
; to the CLAIMID - but we have a problem - what if you want to
; reverse two paid claims in the same CLAIMID. That will have to
; be fixed, to append R and and the MEDIEN. Separate issue, someday.
; F now, go through the POS file - if you find a successful
; reversal with a reversal response higher than RESPIEN, then
; it must have been reversed.
N REVERSED S REVERSED=0
N RXI S RXI=0
N STOP S STOP=0
F S RXI=$O(^ABSPT("AF",RESPIEN,RXI)) Q:RXI="" D Q:STOP
. I $P(^ABSPT(RXI,0),U,9)=MEDIEN S STOP=1 Q
I RXI D ; this prescription has this RESPIEN and position = MEDIEN
. I '$G(^ABSPT(RXI,4)) Q ; no reversal activity
. ; Make sure the reversal has a response & it's earlier than
. ; this paid response:
. I $P(^ABSPT(RXI,4),U,2)'>RESPIEN Q
. N X S X=$$RXPAID^ABSPOSNC(RXI) ; convenient routine to query this
. I $P(X,U,3)="Accepted reversal" S REVERSED=1
Q REVERSED
ABSPER20 ; IHS/FCS/DRS - Payable claims report ; [ 09/12/2002 10:01 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;Pharmacy Claim Payable Report (by Tran Date, Sorted by Insurer)
+5 ;----------------------------------------------------------------------
EN ; option ABSP PAYABLE REPORT
+1 NEW SCRNTXT,SDATE,EDATE,ANS,XBRP,J,XBNS,RPTNAME,PREFIXES
+2 ;
+3 DO DT^DICRW
+4 DO HOME^%ZIS
+5 ;
+6 SET RPTNAME="RX Payable RPT"
+7 SET SCRNTXT="Pharmacy Claim Payable Report (by Transmission Date)"
+8 DO WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
+9 WRITE !
+10 ;
+11 ; report which claims?
SET PREFIXES=$$PREFIXES^ABSPER10
IF "^"[PREFIXES
QUIT
+12 ;
+13 ;Start Date Prompt
+14 SET (SDATE,EDATE)=""
LP1 SET ANS=$$DATE^ABSPOSU1("Transmission - Start Date: ",SDATE,1,"","DT","E",DTIME)
+1 IF ANS=-1!(ANS="^")!(ANS="^^")!(ANS="")
GOTO EXIT
+2 SET SDATE=ANS
+3 ;
+4 ;End Date Prompt
LP2 SET ANS=$$DATE^ABSPOSU1("Transmission - End Date: ",EDATE,1,SDATE,"DT","E",DTIME)
+1 IF ANS="^"
DO WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
GOTO LP1
+2 IF ANS=-1!(ANS="^^")!(ANS="")
GOTO EXIT
+3 SET EDATE=ANS
+4 ;
+5 SET XBRP="RPT^ABSPER20"
+6 FOR J="SDATE","EDATE","SCRNTXT","RPTNAME","PREFIXES"
SET XBNS(J)=""
+7 DO ^XBDBQUE
EXIT QUIT
+1 ;----------------------------------------------------------------------
RPT NEW PAGE
+1 USE IO
+2 KILL ^TMP($JOB,RPTNAME)
+3 DO SET
+4 DO PRINT^ABSPER2A
+5 DO ^%ZISC
+6 KILL ^TMP($JOB,RPTNAME)
+7 QUIT
+8 ;----------------------------------------------------------------------
SET NEW DATE1,DATE2,TDATE,RESPIEN,MEDIEN,CLAIMIEN,DATA,CLAIMID,INSIEN
+1 NEW INSNAME,INSHELP,BITEMIEN,PCN,PATNAME,NDC
+2 NEW INGRPD,DISPPD,TOTPD,PATPAY,REMDED,PSIEN
SET PSIEN=1
+3 ;
+4 SET DATE1=$$CDTFM^ABSPOSU1(SDATE,-1)_".245959"
+5 SET DATE2=EDATE_".245959"
+6 KILL ^TMP($JOB,RPTNAME)
+7 IF IOM<132
QUIT
+8 ;
+9 ;Loop through "AE" x-ref and gather responses within date range
+10 SET TDATE=DATE1
+11 FOR
Begin DoDot:1
+12 SET TDATE=$ORDER(^ABSPR("AE",TDATE))
+13 IF TDATE=""!(TDATE>DATE2)
QUIT
+14 SET RESPIEN=0
+15 FOR
Begin DoDot:2
+16 SET RESPIEN=$ORDER(^ABSPR("AE",TDATE,RESPIEN))
+17 IF '+RESPIEN
QUIT
+18 ;Determine if response has paid items
+19 IF '$DATA(^ABSPR("AC","P",RESPIEN))
QUIT
+20 ;Loop through payable index and get medication records
+21 SET MEDIEN=0
+22 FOR
Begin DoDot:3
+23 SET MEDIEN=$ORDER(^ABSPR("AC","P",RESPIEN,MEDIEN))
+24 IF '+MEDIEN
QUIT
+25 ;Get needed data from 9002313.02 file
+26 SET CLAIMIEN=$PIECE($GET(^ABSPR(RESPIEN,0)),U,1)
+27 IF CLAIMIEN=""
QUIT
+28 IF '$DATA(^ABSPC(CLAIMIEN,0))
QUIT
+29 SET DATA=$GET(^ABSPC(CLAIMIEN,0))
+30 SET CLAIMID=$PIECE(DATA,U,1)
+31 ; but do we want this claim?
IF PREFIXES]""
IF PREFIXES'[$EXTRACT(CLAIMID)
QUIT
+32 SET INSIEN=$PIECE(DATA,U,2)
+33 IF '+INSIEN
QUIT
+34 SET INSNAME=$PIECE($GET(^AUTNINS(INSIEN,0)),U,1)
+35 IF INSNAME=""
QUIT
+36 SET INSHELP=$$INSHELP^ABSPER10(INSIEN)
+37 SET BITEMIEN=$PIECE(DATA,U,3)
+38 ;either PCN or VCN displays
SET PCN=$SELECT(BITEMIEN="":"",$PIECE($GET(^ABSP(9002313.99,+$GET(PSIEN),2)),U,1)="VCN":$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,"VCN")),U,1),1:$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,0)),U,1))
+39 IF PCN=""
SET PCN="RX# "_$$RXNUM
+40 SET PATNAME=$PIECE($GET(^ABSPC(CLAIMIEN,1)),U,1)
+41 SET DATA=$GET(^ABSPC(CLAIMIEN,400,MEDIEN,400))
+42 SET NDC=$PIECE(DATA,U,7)
+43 ;Get and format fields from 9002313.03 for Medication record
+44 SET DATA=$GET(^ABSPR(RESPIEN,1000,MEDIEN,500))
+45 ; But if the claim has been successfully reversed, rig $ fields
+46 IF $$REVERSED(RESPIEN,MEDIEN)
Begin DoDot:4
+47 SET (INGRPD,DISPPD,PATPAY,REMDED)=""
+48 SET TOTPD="REVERSED"
End DoDot:4
+49 IF '$TEST
Begin DoDot:4
+50 SET INGRPD=$JUSTIFY($$DFF2EXT^ABSPECFM($PIECE(DATA,U,6)),7,2)
+51 SET DISPPD=$JUSTIFY($$DFF2EXT^ABSPECFM($PIECE(DATA,U,7)),7,2)
+52 SET TOTPD=$JUSTIFY($$DFF2EXT^ABSPECFM($PIECE(DATA,U,9)),9,2)
+53 SET PATPAY=$JUSTIFY($$DFF2EXT^ABSPECFM($PIECE(DATA,U,5)),9,2)
+54 SET REMDED=$JUSTIFY($$DFF2EXT^ABSPECFM($PIECE(DATA,U,13)),11,2)
End DoDot:4
+55 SET ^TMP($JOB,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN)=CLAIMID_U_PCN_U_PATNAME_U_NDC_U_INGRPD_U_DISPPD_U_TOTPD_U_PATPAY_U_REMDED
+56 SET ^TMP($JOB,RPTNAME,INSNAME)=INSHELP
End DoDot:3
IF 'MEDIEN
QUIT
End DoDot:2
IF '+RESPIEN
QUIT
End DoDot:1
IF TDATE=""!(TDATE>DATE2)
QUIT
+57 QUIT
RXNUM() ;EP - from ABSPER10,ABSPER30
+1 ; try to return external #; try to append refill # if nonzero
+2 ; given CLAIMIEN, MEDIEN pointers into ^ABSPC
+3 NEW X
SET X=+$PIECE($GET(^ABSPC(CLAIMIEN,400,MEDIEN,400)),U,2)
+4 IF 'X
QUIT ""
+5 IF $DATA(^PSRX(X))
SET X=$PIECE(^PSRX(X,0),U)
+6 IF '$TEST
SET X="`"_X
+7 NEW Y
SET Y=+$PIECE($GET(^ABSPC(CLAIMIEN,400,MEDIEN,400)),U,3)
+8 IF Y
SET X=X_"r"_+Y
+9 QUIT X
REVERSED(RESPIEN,MEDIEN) ; $$ = 1 if yes, = 0 if no
+1 ; It would be nice to use the numbering scheme - of attaching "R"
+2 ; to the CLAIMID - but we have a problem - what if you want to
+3 ; reverse two paid claims in the same CLAIMID. That will have to
+4 ; be fixed, to append R and and the MEDIEN. Separate issue, someday.
+5 ; F now, go through the POS file - if you find a successful
+6 ; reversal with a reversal response higher than RESPIEN, then
+7 ; it must have been reversed.
+8 NEW REVERSED
SET REVERSED=0
+9 NEW RXI
SET RXI=0
+10 NEW STOP
SET STOP=0
+11 FOR
SET RXI=$ORDER(^ABSPT("AF",RESPIEN,RXI))
IF RXI=""
QUIT
Begin DoDot:1
+12 IF $PIECE(^ABSPT(RXI,0),U,9)=MEDIEN
SET STOP=1
QUIT
End DoDot:1
IF STOP
QUIT
+13 ; this prescription has this RESPIEN and position = MEDIEN
IF RXI
Begin DoDot:1
+14 ; no reversal activity
IF '$GET(^ABSPT(RXI,4))
QUIT
+15 ; Make sure the reversal has a response & it's earlier than
+16 ; this paid response:
+17 IF $PIECE(^ABSPT(RXI,4),U,2)'>RESPIEN
QUIT
+18 ; convenient routine to query this
NEW X
SET X=$$RXPAID^ABSPOSNC(RXI)
+19 IF $PIECE(X,U,3)="Accepted reversal"
SET REVERSED=1
End DoDot:1
+20 QUIT REVERSED
