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

ABSPER4A.m

Go to the documentation of this file.
  1. ABSPER4A ; IHS/FCS/DRS - JWS 10:29 AM 17 Jul 1996 ; [ 09/12/2002 10:03 AM ]
  1. ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1. ;----------------------------------------------------------------------
  1. ;----------------------------------------------------------------------
  1. ;Pharmacy Claim Rejection Report - CODE 40 - (by Tran Date, Sorted by Insurer)
  1. ;----------------------------------------------------------------------
  1. HEADER1 S PAGE=$G(PAGE)+1
  1. W @IOF ;D ^AUCLS
  1. W $$LJBF^ABSPOSU9(SCRNTXT,IOM-10)_$$LJBF^ABSPOSU9("PAGE "_PAGE,10),!
  1. W $TR($J("",IOM)," ","-"),!
  1. Q
  1. ;----------------------------------------------------------------------
  1. HEADER2 I '$D(PSIEN) N PSIEN S PSIEN=1
  1. W !
  1. W "Insurer:",?11,$$LJBF^ABSPOSU9(INSNAME,46)
  1. W ?61,"Help #:",?70,$$LJBF^ABSPOSU9($G(^TMP($J,RPTNAME,INSNAME)),20)
  1. W ?92,"Transmission Dates:"
  1. W ?113,$$LJBF^ABSPOSU9($$FM2MDY^ABSPOSU1(SDATE),8)_" - "
  1. W $$LJBF^ABSPOSU9($$FM2MDY^ABSPOSU1(EDATE),8),!
  1. ;D WCOLUMNS^ABSPOSU9(0,2,"Trans On:8,Claim ID:16,"_$P($G(^ABSP(9002313.99,PSIEN,2)),U,1)_" #:12,Patient Name:20,Cardholder ID:15,NDC #:13,Rejection Reason(s):36",1)
  1. D WCOLUMNS^ABSPOSU9(0,2,"Patient Name:20,"_$P($G(^ABSP(9002313.99,PSIEN,2)),U,1)_" #:12,MCAID #:15,Date Filled:8,Presc.#:12,NDC #:13,QTY:3,Days Supply:11,Charge:8",1)
  1. Q
  1. ;----------------------------------------------------------------------
  1. PRINT ;EP - from ABSPER40
  1. N FLAG,INSNAME,TDATE,ANS,RESPIEN,MEDIEN,DATA,TRANSON,CLAIMID,VCN
  1. N PATNAME,CARDID,NDC,RJCTCNT,RJCTN,RJCTTEXT,CHG,MCAID,QTY,SUP
  1. I IOM<132 D Q
  1. .D HEADER1
  1. .W !,"Device selected does not support 132 column reports.",!
  1. .D:(IO=$P) PRESSANY^ABSPOSU5(1,DTIME)
  1. S FLAG=0,INSNAME=""
  1. F D Q:INSNAME=""!(FLAG)
  1. .S INSNAME=$O(^TMP($J,RPTNAME,INSNAME))
  1. .Q:INSNAME=""
  1. .D HEADER1,HEADER2
  1. .S TDATE=""
  1. .F D Q:'+TDATE!(FLAG)
  1. ..S TDATE=$O(^TMP($J,RPTNAME,INSNAME,TDATE))
  1. ..Q:'+TDATE
  1. ..S RESPIEN=""
  1. ..F D Q:'+RESPIEN!(FLAG)
  1. ...S RESPIEN=$O(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN))
  1. ...Q:'+RESPIEN
  1. ...S MEDIEN=""
  1. ...F D Q:'+MEDIEN!(FLAG)
  1. ....S MEDIEN=$O(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN))
  1. ....Q:'+MEDIEN
  1. ....S DATA=$G(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN))
  1. ....S TRANSON=$$FM2MDY^ABSPOSU1(TDATE)
  1. ....S CLAIMID=$P(DATA,U,1)
  1. ....S VCN=$P(DATA,U,2)
  1. ....S PATNAME=$P(DATA,U,3)
  1. ....S CARDID=$P(DATA,U,4)
  1. ....S MCAID=999999
  1. ....S QTY="TST"
  1. ....S SUP="TST"
  1. ....S CHG=500
  1. ....S NDC=$P(DATA,U,5)
  1. ....S RJCTCNT=$P(DATA,U,6)
  1. ....F RJCTN=1:1:RJCTCNT D Q:FLAG
  1. .....S RJCTTEXT=$G(^TMP($J,RPTNAME,INSNAME,TDATE,RESPIEN,MEDIEN,RJCTN))
  1. .....S:RJCTTEXT="" RJCTTEXT="Undefined Error"
  1. .....I ($Y+2)>IOSL,'(IO=$P) D HEADER1,HEADER2
  1. .....I ($Y+2)>IOSL,(IO=$P),($E(IOST,1,1)="C") D
  1. ......S ANS=$$ENDPAGE^ABSPOSU5(0,DTIME)
  1. ......S:ANS=-1!(ANS="^") FLAG=1
  1. ......I 'FLAG D HEADER1,HEADER2
  1. .....D:'FLAG&(RJCTN=1) WDATA^ABSPOSU9(0,2,"PATNAME:20,VCN:12,MCAID:15,TDATE:8,MEDIEN:12,NDC:13,QTY:3,SUP:11,CHG:8")
  1. .....D:'FLAG&(RJCTN>1) WDATA^ABSPOSU9(96,0,"RJCTTEXT:36")
  1. Q:FLAG
  1. D:(IO=$P) PRESSANY^ABSPOSU5(1,DTIME)
  1. Q