- 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
