- ABSPER30 ; IHS/FCS/DRS - JWS 10:33 AM 17 Jul 1996 ; [ 09/12/2002 10:02 AM ]
- ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
- ;----------------------------------------------------------------------
- ;----------------------------------------------------------------------
- ;Transmission STATUS Report (Claim Summary)
- ;----------------------------------------------------------------------
- EN ;EP - option ABSP TRANS STATUS BY CLAIM
- N SCRNTXT,SDATE,EDATE,ANS,XBRP,J,XBNS,RPTNAME
- ;
- D DT^DICRW
- D HOME^%ZIS
- ;
- S RPTNAME="RX Claim STATUS RPT"
- S SCRNTXT="Transmission STATUS Report (Claim Summary)"
- D WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
- W !
- ;
- ;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^ABSPER30"
- 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^ABSPER3A
- D ^%ZISC
- K ^TMP($J,RPTNAME)
- Q
- ;----------------------------------------------------------------------
- SORT N DATE1,DATE2,TDATE,RESPIEN,MEDIEN,CLAIMIEN,DATA,CLAIMID,INSIEN
- N INSNAME,BITEMIEN,PCN,PATNAME,NDC,RX,FDATE,STATUS
- N DIALOUT S DIALOUT=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
- ..S MEDIEN=0
- ..F D Q:'MEDIEN
- ...S MEDIEN=$O(^ABSPR(RESPIEN,1000,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)
- ...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,DIALOUT,2)),U,2)="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^ABSPER20
- ...S PATNAME=$P($G(^ABSPC(CLAIMIEN,1)),U,1)
- ...S DATA=$G(^ABSPC(CLAIMIEN,400,MEDIEN,400))
- ...S RX=$P(DATA,U,2)
- ...S NDC=$P(DATA,U,7)
- ...S DATA=$P($G(^ABSPC(CLAIMIEN,401)),U,1)
- ...S FDATE=$E(DATA,5,6)_"/"_$E(DATA,7,8)_"/"_$E(DATA,3,4)
- ...;G and format fields from 9002313.03 for Medication record
- ...S DATA=$G(^ABSPR(RESPIEN,1000,MEDIEN,500))
- ...I $P($G(^ABSPR(RESPIEN,100)),U,3)=11 D
- .... S STATUS=$P($G(^ABSPR(RESPIEN,500)),U)_" R" ; "A R" or "R R"
- ...E S STATUS=$P(DATA,U,1) ; not reversal
- ...S STATUS=$S(STATUS="D":"Duplicate",STATUS="P":"Payable",STATUS="R":"Rejected",STATUS="C":"Captured",STATUS="A R":"Reversal",STATUS="R R":"RejectRev",1:"Undefined")
- ...S ^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN)=CLAIMID_U_PCN_U_PATNAME_U_FDATE_U_NDC_U_RX_U_STATUS
- Q
- ABSPER30 ; IHS/FCS/DRS - JWS 10:33 AM 17 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 (Claim Summary)
- +5 ;----------------------------------------------------------------------
- EN ;EP - option ABSP TRANS STATUS BY CLAIM
- +1 NEW SCRNTXT,SDATE,EDATE,ANS,XBRP,J,XBNS,RPTNAME
- +2 ;
- +3 DO DT^DICRW
- +4 DO HOME^%ZIS
- +5 ;
- +6 SET RPTNAME="RX Claim STATUS RPT"
- +7 SET SCRNTXT="Transmission STATUS Report (Claim Summary)"
- +8 DO WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
- +9 WRITE !
- +10 ;
- +11 ;Start Date Prompt
- +12 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^ABSPER30"
- +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^ABSPER3A
- +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,NDC,RX,FDATE,STATUS
- +2 NEW DIALOUT
- SET DIALOUT=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 SET MEDIEN=0
- +19 FOR
- Begin DoDot:3
- +20 SET MEDIEN=$ORDER(^ABSPR(RESPIEN,1000,MEDIEN))
- +21 IF '+MEDIEN
- QUIT
- +22 ;Get needed data from 9002313.02 file
- +23 SET CLAIMIEN=$PIECE($GET(^ABSPR(RESPIEN,0)),U,1)
- +24 IF CLAIMIEN=""
- QUIT
- +25 IF '$DATA(^ABSPC(CLAIMIEN,0))
- QUIT
- +26 SET DATA=$GET(^ABSPC(CLAIMIEN,0))
- +27 SET CLAIMID=$PIECE(DATA,U,1)
- +28 SET INSIEN=$PIECE(DATA,U,2)
- +29 IF '+INSIEN
- QUIT
- +30 SET INSNAME=$PIECE($GET(^AUTNINS(INSIEN,0)),U,1)
- +31 IF INSNAME=""
- QUIT
- +32 SET BITEMIEN=$PIECE(DATA,U,3)
- +33 ;either PCN or VCN displays
- SET PCN=$SELECT(BITEMIEN="":"",$PIECE($GET(^ABSP(9002313.99,DIALOUT,2)),U,2)="VCN":$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,"VCN")),U,1),1:$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,0)),U,1))
- +34 IF PCN=""
- SET PCN="RX# "_$$RXNUM^ABSPER20
- +35 SET PATNAME=$PIECE($GET(^ABSPC(CLAIMIEN,1)),U,1)
- +36 SET DATA=$GET(^ABSPC(CLAIMIEN,400,MEDIEN,400))
- +37 SET RX=$PIECE(DATA,U,2)
- +38 SET NDC=$PIECE(DATA,U,7)
- +39 SET DATA=$PIECE($GET(^ABSPC(CLAIMIEN,401)),U,1)
- +40 SET FDATE=$EXTRACT(DATA,5,6)_"/"_$EXTRACT(DATA,7,8)_"/"_$EXTRACT(DATA,3,4)
- +41 ;G and format fields from 9002313.03 for Medication record
- +42 SET DATA=$GET(^ABSPR(RESPIEN,1000,MEDIEN,500))
- +43 IF $PIECE($GET(^ABSPR(RESPIEN,100)),U,3)=11
- Begin DoDot:4
- +44 ; "A R" or "R R"
- SET STATUS=$PIECE($GET(^ABSPR(RESPIEN,500)),U)_" R"
- End DoDot:4
- +45 ; not reversal
- IF '$TEST
- SET STATUS=$PIECE(DATA,U,1)
- +46 SET STATUS=$SELECT(STATUS="D":"Duplicate",STATUS="P":"Payable",STATUS="R":"Rejected",STATUS="C":"Captured",STATUS="A R":"Reversal",STATUS="R R":"RejectRev",1:"Undefined")
- +47 SET ^TMP($JOB,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN)=CLAIMID_U_PCN_U_PATNAME_U_FDATE_U_NDC_U_RX_U_STATUS
- End DoDot:3
- IF 'MEDIEN
- QUIT
- End DoDot:2
- IF '+RESPIEN
- QUIT
- End DoDot:1
- IF TDATE=""!(TDATE>DATE2)
- QUIT
- +48 QUIT
