ABSPER40 ; IHS/FCS/DRS - JWS 03:58 PM 16 Jul 1996 ; [ 09/12/2002 10:02 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Transmission STATUS Report (Billing Item Summary)
;----------------------------------------------------------------------
EN ; option ABSP TRANS STATUS BITEM
N SCRNTXT,SDATE,EDATE,ANS,XBRP,J,XBNS,RPTNAME
;
D DT^DICRW
D HOME^%ZIS
;
S RPTNAME="RX BItem STATUS RPT"
S SCRNTXT="Transmission STATUS Report (Billing Item Summary)"
D WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
W !
;
;Start Date Prompt
S (SDATE,EDATE)=""
LP1 S ANS=$$DATE^ABSPOSU1("Visit Date - 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("Visit Date - 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^ABSPER40"
F J="SDATE","EDATE","SCRNTXT","RPTNAME" S XBNS(J)=""
D ^XBDBQUE
EXIT Q
;----------------------------------------------------------------------
RPT N PAGE
U IO
K ^TMP($J,RPTNAME)
D SORT
D PRINT^ABSPER4A
D ^%ZISC
K ^TMP($J,RPTNAME)
Q
;----------------------------------------------------------------------
SORT N DATE1,DATE2,TDATE,RESPIEN,MEDIEN,CLAIMIEN,DATA,CLAIMID,INSIEN
N INSNAME,BITEMIEN,PCN,PATNAME,FDATA,RX,NDC,TRANSON,STATUS,VDATE
N FDATE,PSIEN S PSIEN=1
;
S DATE1=$$DTF1^ABSPECFM($$CDTFM^ABSPOSU1(SDATE,-1))
S DATE2=$$DTF1^ABSPECFM(EDATE)
K ^TMP($J,RPTNAME)
Q:IOM<132
;
;Loop through "AF" x-ref and gather claims within date range
S VDATE=DATE1
F D Q:VDATE=""!(VDATE>DATE2)
.S VDATE=$O(^ABSPC("AF",VDATE))
.Q:VDATE=""!(VDATE>DATE2)
.S CLAIMIEN=0
.F D Q:'+CLAIMIEN
..S CLAIMIEN=$O(^ABSPC("AF",VDATE,CLAIMIEN))
..Q:'+CLAIMIEN
..;Get needed data from 9002313.02 file
..S DATA=$G(^ABSPC(CLAIMIEN,0))
..S CLAIMID=$P(DATA,U,1)
..S INSIEN=$P(DATA,U,2)
..Q:'+INSIEN
..S INSNAME=$P($G(^AUTNINS(INSIEN,0)),U,1)
..Q:INSNAME=""
..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
..S PATNAME=$P($G(^ABSPC(CLAIMIEN,1)),U,1)
..S DATA=$P($G(^ABSPC(CLAIMIEN,401)),U,1)
..S FDATE=$E(DATA,5,6)_"/"_$E(DATA,7,8)_"/"_$E(DATA,3,4)
..S MEDIEN=0
..F D Q:'MEDIEN
...S MEDIEN=$O(^ABSPC(CLAIMIEN,400,MEDIEN))
...Q:'+MEDIEN
...S DATA=$G(^ABSPC(CLAIMIEN,400,MEDIEN,400))
...S RX=$P(DATA,U,2)
...S NDC=$P(DATA,U,7)
...;
...I $D(^ABSPR("B",CLAIMIEN))=0 D Q
....S ^TMP($J,RPTNAME,INSNAME,PCN,CLAIMIEN,0,MEDIEN)=CLAIMID_U_PATNAME_U_FDATE_U_NDC_U_RX_U_"Not Sent"_U_""
...I $D(^ABSPR("B",CLAIMIEN))'=0 D Q
....S RESPIEN=0
....F D Q:'+RESPIEN
.....S RESPIEN=$O(^ABSPR("B",CLAIMIEN,RESPIEN))
.....Q:'+RESPIEN
.....S TRANSON=$P($G(^ABSPR(RESPIEN,0)),U,2)
.....S TRANSON=$$FM2MDY^ABSPOSU1(TRANSON)
.....S DATA=$G(^ABSPR(RESPIEN,1000,MEDIEN,500))
.....S STATUS=$P(DATA,U,1)
.....S STATUS=$S(STATUS="D":"Duplicate",STATUS="P":"Payable",STATUS="R":"Rejected",STATUS="C":"Captured",1:"Undefined")
.....S ^TMP($J,RPTNAME,INSNAME,PCN,CLAIMIEN,RESPIEN,MEDIEN)=CLAIMID_U_PATNAME_U_FDATE_U_NDC_U_RX_U_TRANSON_U_STATUS
Q
ABSPER40 ; IHS/FCS/DRS - JWS 03:58 PM 16 Jul 1996 ; [ 09/12/2002 10:02 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;Transmission STATUS Report (Billing Item Summary)
+5 ;----------------------------------------------------------------------
EN ; option ABSP TRANS STATUS BITEM
+1 NEW SCRNTXT,SDATE,EDATE,ANS,XBRP,J,XBNS,RPTNAME
+2 ;
+3 DO DT^DICRW
+4 DO HOME^%ZIS
+5 ;
+6 SET RPTNAME="RX BItem STATUS RPT"
+7 SET SCRNTXT="Transmission STATUS Report (Billing Item Summary)"
+8 DO WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
+9 WRITE !
+10 ;
+11 ;Start Date Prompt
+12 SET (SDATE,EDATE)=""
LP1 SET ANS=$$DATE^ABSPOSU1("Visit Date - 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("Visit Date - 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^ABSPER40"
+6 FOR J="SDATE","EDATE","SCRNTXT","RPTNAME"
SET XBNS(J)=""
+7 DO ^XBDBQUE
EXIT QUIT
+1 ;----------------------------------------------------------------------
RPT NEW PAGE
+1 USE IO
+2 KILL ^TMP($JOB,RPTNAME)
+3 DO SORT
+4 DO PRINT^ABSPER4A
+5 DO ^%ZISC
+6 KILL ^TMP($JOB,RPTNAME)
+7 QUIT
+8 ;----------------------------------------------------------------------
SORT NEW DATE1,DATE2,TDATE,RESPIEN,MEDIEN,CLAIMIEN,DATA,CLAIMID,INSIEN
+1 NEW INSNAME,BITEMIEN,PCN,PATNAME,FDATA,RX,NDC,TRANSON,STATUS,VDATE
+2 NEW FDATE,PSIEN
SET PSIEN=1
+3 ;
+4 SET DATE1=$$DTF1^ABSPECFM($$CDTFM^ABSPOSU1(SDATE,-1))
+5 SET DATE2=$$DTF1^ABSPECFM(EDATE)
+6 KILL ^TMP($JOB,RPTNAME)
+7 IF IOM<132
QUIT
+8 ;
+9 ;Loop through "AF" x-ref and gather claims within date range
+10 SET VDATE=DATE1
+11 FOR
Begin DoDot:1
+12 SET VDATE=$ORDER(^ABSPC("AF",VDATE))
+13 IF VDATE=""!(VDATE>DATE2)
QUIT
+14 SET CLAIMIEN=0
+15 FOR
Begin DoDot:2
+16 SET CLAIMIEN=$ORDER(^ABSPC("AF",VDATE,CLAIMIEN))
+17 IF '+CLAIMIEN
QUIT
+18 ;Get needed data from 9002313.02 file
+19 SET DATA=$GET(^ABSPC(CLAIMIEN,0))
+20 SET CLAIMID=$PIECE(DATA,U,1)
+21 SET INSIEN=$PIECE(DATA,U,2)
+22 IF '+INSIEN
QUIT
+23 SET INSNAME=$PIECE($GET(^AUTNINS(INSIEN,0)),U,1)
+24 IF INSNAME=""
QUIT
+25 SET BITEMIEN=$PIECE(DATA,U,3)
+26 ;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))
+27 SET PATNAME=$PIECE($GET(^ABSPC(CLAIMIEN,1)),U,1)
+28 SET DATA=$PIECE($GET(^ABSPC(CLAIMIEN,401)),U,1)
+29 SET FDATE=$EXTRACT(DATA,5,6)_"/"_$EXTRACT(DATA,7,8)_"/"_$EXTRACT(DATA,3,4)
+30 SET MEDIEN=0
+31 FOR
Begin DoDot:3
+32 SET MEDIEN=$ORDER(^ABSPC(CLAIMIEN,400,MEDIEN))
+33 IF '+MEDIEN
QUIT
+34 SET DATA=$GET(^ABSPC(CLAIMIEN,400,MEDIEN,400))
+35 SET RX=$PIECE(DATA,U,2)
+36 SET NDC=$PIECE(DATA,U,7)
+37 ;
+38 IF $DATA(^ABSPR("B",CLAIMIEN))=0
Begin DoDot:4
+39 SET ^TMP($JOB,RPTNAME,INSNAME,PCN,CLAIMIEN,0,MEDIEN)=CLAIMID_U_PATNAME_U_FDATE_U_NDC_U_RX_U_"Not Sent"_U_""
End DoDot:4
QUIT
+40 IF $DATA(^ABSPR("B",CLAIMIEN))'=0
Begin DoDot:4
+41 SET RESPIEN=0
+42 FOR
Begin DoDot:5
+43 SET RESPIEN=$ORDER(^ABSPR("B",CLAIMIEN,RESPIEN))
+44 IF '+RESPIEN
QUIT
+45 SET TRANSON=$PIECE($GET(^ABSPR(RESPIEN,0)),U,2)
+46 SET TRANSON=$$FM2MDY^ABSPOSU1(TRANSON)
+47 SET DATA=$GET(^ABSPR(RESPIEN,1000,MEDIEN,500))
+48 SET STATUS=$PIECE(DATA,U,1)
+49 SET STATUS=$SELECT(STATUS="D":"Duplicate",STATUS="P":"Payable",STATUS="R":"Rejected",STATUS="C":"Captured",1:"Undefined")
+50 SET ^TMP($JOB,RPTNAME,INSNAME,PCN,CLAIMIEN,RESPIEN,MEDIEN)=CLAIMID_U_PATNAME_U_FDATE_U_NDC_U_RX_U_TRANSON_U_STATUS
End DoDot:5
IF '+RESPIEN
QUIT
End DoDot:4
QUIT
End DoDot:3
IF 'MEDIEN
QUIT
End DoDot:2
IF '+CLAIMIEN
QUIT
End DoDot:1
IF VDATE=""!(VDATE>DATE2)
QUIT
+51 QUIT
