Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPECZA

ABSPECZA.m

Go to the documentation of this file. 
  1. ABSPECZA ; IHS/FCS/DRS - JWS 04:27 PM 28 Sep 1995 ;   [ 09/12/2002  10:01 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  ;----------------------------------------------------------------------
  1.  ;----------------------------------------------------------------------
  1. DISPLAY(SCRNTXT,IEN) ;EP - from ABSPECZ2 and ABSPECZ3
  1.  ;Manage local variables
  1.  N DIC,DR,DA,DIQ,DR,F1,F2,F3,F4,CFLDS,RFLDS,RDA,CDA
  1.  N RJTCODE,RJTNEXT,RJTDA,RJTCOUNT,ANS
  1.  ;
  1.  ;Make sure input variables are defined
  1.  Q:$G(SCRNTXT)=""
  1.  Q:$G(IEN)=""
  1.  ;
  1.  ;G data from Claim Submission Record
  1.  S CDA=$P(IEN,U,1)
  1.  S F1=9002313.02,F2=9002313.0201
  1.  S DIC="^ABSPC(" ; 03/12/2001
  1.  S DR=".01;.02;.05;1.01;1.02;1.03;301;302;3004;400"
  1.  S DA=$P(IEN,U,1)
  1.  S DIQ="CFLDS"
  1.  S DIQ(0)="E"
  1.  S DR(F2)=".04;401:405;407;409:412"
  1.  S DA(F2)=$P(IEN,U,2)
  1.  D EN^DIQ1
  1.  ;
  1.  ;G data from Claim Response Record
  1.  S RDA=$P(IEN,U,3)
  1.  I RDA'="" D
  1.  .S F3=9002313.03,F4=9002313.0301
  1.  .S DIC="^ABSPR(" ; 03/12/2001
  1.  .S DR=".02;1000"
  1.  .S (RDA,DA)=$P(IEN,U,3)
  1.  .S DIQ="RFLDS"
  1.  .S DIQ(0)="E"
  1.  .S DR(F4)="501;503;504;505;506;507;508;509;510;513"
  1.  .S DA(F4)=$P(IEN,U,2)
  1.  .D EN^DIQ1
  1.  ;
  1.  D WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
  1.  W !
  1.  W "Claim ID:",?14,$G(CFLDS(F1,CDA,.01,"E"))
  1.  W ?46,"Sent On:",?61,$P($G(CFLDS(F1,CDA,.05,"E")),"@",1),!
  1.  W "PCN#:",?14,$G(CFLDS(F1,CDA,1.02,"E"))
  1.  W ?46,"VCN#:",?61,$G(CFLDS(F1,CDA,1.03,"E")),!
  1.  W $TR($J("",80)," ","-"),!
  1.  ;
  1.  W "Insurer:",?14,$G(CFLDS(F1,CDA,.02,"E"))
  1.  W ?46,"Group #:",?61,$G(CFLDS(F1,CDA,301,"E")),!
  1.  W "Patient:",?14,$G(CFLDS(F1,CDA,1.01,"E"))
  1.  W ?46,"Card #:",?61,$G(CFLDS(F1,CDA,302,"E")),!
  1.  ;
  1.  W $TR($J("",80)," ","-"),!
  1.  W "Medication:",?14,$G(CFLDS(F2,DA(F2),.04,"E")),!
  1.  W "NDC #:",?14,$G(CFLDS(F2,DA(F2),407,"E"))
  1.  W ?46,"Prescriber:",?61,$G(CFLDS(F2,DA(F2),411,"E")),!
  1.  W "RX #:",?14,$G(CFLDS(F2,DA(F2),402,"E"))
  1.  W ?46,"Date Filled:",?61,$G(CFLDS(F2,DA(F2),401,"E")),!
  1.  W "N/Refill:",?14,$G(CFLDS(F2,DA(F2),403,"E"))
  1.  W ?46,"Ingr Cost:",?61,$G(CFLDS(F2,DA(F2),409,"E")),!
  1.  W "Quantity:",?14,$G(CFLDS(F2,DA(F2),404,"E"))
  1.  W ?46,"Sales Tax:",?61,$G(CFLDS(F2,DA(F2),410,"E")),!
  1.  W "Day Supply:",?14,$G(CFLDS(F2,DA(F2),405,"E"))
  1.  W ?46,"Disp Fee:",?61,$G(CFLDS(F2,DA(F2),412,"E")),!
  1.  ;
  1.  I RDA="" D PRESSANY^ABSPOSU5(1,DTIME) Q
  1.  ;
  1.  W $TR($J("",80)," ","-"),!
  1.  ;
  1.  I $G(RFLDS(F4,DA(F4),501,"E"))="CLAIM PAYABLE" D
  1.  .W "Resp Status:",?14,$G(RFLDS(F4,DA(F4),501,"E"))
  1.  .W ?46,"Ingr Cost Pd:",?61,$G(RFLDS(F4,DA(F4),506,"E")),!
  1.  .W "Patient Pay:",?14,$G(RFLDS(F4,DA(F4),505,"E"))
  1.  .W ?46,"Sales Tax Pd:",?61,$G(RFLDS(F4,DA(F4),508,"E")),!
  1.  .W "Rem Ded Amt:",?14,$G(RFLDS(F4,DA(F4),513,"E"))
  1.  .W ?46,"Disp Fee Pd:",?61,$G(RFLDS(F4,DA(F4),507,"E")),!
  1.  .W "Authoriz #:",?14,$G(RFLDS(F4,DA(F4),503,"E"))
  1.  .W ?46,"Total Paid:",?61,$G(RFLDS(F4,DA(F4),509,"E")),!
  1.  .W "Message:",?14,$E($G(RFLDS(F4,DA(F4),504,"E")),1,75),!
  1.  .D PRESSANY^ABSPOSU5(1,DTIME)
  1.  ;
  1.  I $G(RFLDS(F4,DA(F4),501,"E"))="CLAIM CAPTURED" D
  1.  .W "Resp Status:",?14,$G(RFLDS(F4,DA(F4),501,"E")),!
  1.  .W "Authoriz #:",?14,$G(RFLDS(F4,DA(F4),503,"E")),!
  1.  .W "Message:",?14,$E($G(RFLDS(F4,DA(F4),504,"E")),1,75),!
  1.  .D PRESSANY^ABSPOSU5(1,DTIME)
  1.  ;
  1.  I $G(RFLDS(F4,DA(F4),501,"E"))="REJECTED CLAIM" D
  1.  .W "Resp Status:",?14,$G(RFLDS(F4,DA(F4),501,"E"))
  1.  .W ?46,"Reject COUNT:",?61,$G(RFLDS(F4,DA(F4),510,"E")),!
  1.  .W "Message:",?14,$E($G(RFLDS(F4,DA(F4),504,"E")),1,75),!
  1.  .S ANS=$$YESNO^ABSPOSU3("DISPLAY Reject CODEs","NO",0,DTIME)
  1.  .Q:ANS'=1
  1.  .D WHEADER^ABSPOSU9(SCRNTXT,IOF,IOM)
  1.  .W !
  1.  .W "Claim ID:",?14,$G(CFLDS(F1,CDA,.01,"E"))
  1.  .W ?46,"Sent On:",?61,$P($G(CFLDS(F1,CDA,.05,"E")),"@",1),!
  1.  .W $TR($J("",80)," ","-"),!
  1.  .S (RJTCOUNT,RJTNEXT)=0
  1.  .F  D  Q:'+RJTNEXT
  1.  ..S RJTNEXT=$O(^ABSPR(RDA,1000,DA(F4),511,RJTNEXT))
  1.  ..Q:'RJTNEXT
  1.  ..S RJTCODE=$P($G(^ABSPR(RDA,1000,DA(F4),511,RJTNEXT,0)),U,1)
  1.  ..Q:RJTCODE=""
  1.  ..Q:'$D(^ABSPF(9002313.93,"B",RJTCODE))
  1.  ..S RJTDA=$O(^ABSPF(9002313.93,"B",RJTCODE,0))
  1.  ..Q:RJTDA=""
  1.  ..S RJTCOUNT=RJTCOUNT+1
  1.  ..W "Reject "_$J(RJTCOUNT,2)_":",?14,$E($P($G(^ABSPF(9002313.93,RJTDA,0)),U,2),1,75),!
  1.  .D PRESSANY^ABSPOSU5(1,DTIME)
  1.  Q