- 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
