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

ABSPOSFP.m

Go to the documentation of this file. 
  1. ABSPOSFP ; IHS/FCS/DRS - Print NCPDP claim ;   [ 09/12/2002  10:09 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
  1.  ;----------------------------------------------------------------------
  1.  Q
  1. PRINT ; EP - we have the ABSP() and NCPDP() arrays
  1.  ; Print to the current device
  1.  N VOFF,HOFF S VOFF=2,HOFF=0 ; vertical and horizontal offsets
  1.  N A,B,C,I,X,Y,Z
  1.  I $Y'=0 W @IOF ; in case not at top of form
  1.  F I=1:1:VOFF W !
  1.  N MAXRXN S MAXRXN=$O(ABSP("RX"," "),-1)
  1.  N RXN F RXN=1:2:MAXRXN D PAGE
  1.  W @IOF
  1.  Q
  1. PAGE ; print one page
  1.  N RX1,RX2 S RX1=RXN,RX2=RX1+1
  1. 1 W ?6+HOFF,NCPDP(302) ; I.D.
  1.  W ?40+HOFF,NCPDP(301) ; GROUP I.D.
  1.  W !
  1.  W !
  1. 2 W ?10+HOFF,NCPDP(313),",",NCPDP(312) ; NAME (of insured)
  1.  W ?53+HOFF ; PLAN NAME (insurance name?)
  1.  W !
  1.  W !
  1. 3 W ?10+HOFF,NCPDP(311),",",NCPDP(310) ; PATIENT NAME
  1.  W ?44+HOFF,NCPDP(308) ; OTHER COVERAGE CODE
  1.  W ?59+HOFF,NCPDP(303)
  1.  W !
  1.  W !
  1. 4 W ?14+HOFF,$$MM(NCPDP(304)) ; PATIENT DATE OF BIRTH
  1.  W ?19+HOFF,$$DD(NCPDP(304))
  1.  W ?23+HOFF,$$CCYY(NCPDP(304))
  1.  W ?47+HOFF,NCPDP(305) ; PATIENT GENDER CODE
  1.  W ?65+HOFF,NCPDP(306) ; PATIENT RELATIONSHIP CODE
  1.  W !
  1.  W !
  1. 5 W ?11+HOFF,ABSP("Site","Name") ; PHARMACY NAME
  1.  W !
  1.  W !
  1. 6 W ?11+HOFF,ABSP("Site","Addr") ; ADDRESS
  1.  W ?46+HOFF,NCPDP(201) ; SERVICE PROVIDER I.D.
  1.  W ?66 ; QUAL
  1.  W !
  1.  S X=ABSP("Site","Tax ID #") I X]"" W ?46+HOFF,"Tax ID #",X
  1.  W !
  1. 7 W ?11+HOFF,ABSP("Site","City") ; CITY
  1.  W ?47+HOFF,ABSP("Site","Phone") ; PHONE NO.
  1.  W !
  1.  W !
  1. 8 W ?16+HOFF,ABSP("Site","State")," ",ABSP("Site","Zip") ; STATE & ZIP
  1.  W ?47+HOFF,ABSP("Site","Fax") ; FAX NO.
  1.  W !
  1.  W !
  1.  W !
  1. 9 W ?11+HOFF,NCPDP(315) ; WORKERS COMP. INFORMATION - EMPLOYER NAME
  1.  W !
  1.  W !
  1. 10 W ?11+HOFF,NCPDP(316) ; ADDRESS
  1.  W ?53,"Signature on file"
  1.  W !
  1.  W !
  1. 11 W ?11+HOFF,NCPDP(317) ; CITY
  1.  W ?43+HOFF,NCPDP(318) ; STATE
  1.  W ?56+HOFF,NCPDP(319) ; ZIP
  1.  W !
  1.  W !
  1. 12 W ?11+HOFF,NCPDP(327) ; CARRIER I.D.
  1.  W ?45+HOFF ; EMPLOYER PHONE NO.
  1.  W !
  1.  W !
  1. 13 W ?11+HOFF,$$MM(NCPDP("RX",RX1,434)) ; DATE OF INJURY
  1.  W ?16+HOFF,$$DD(NCPDP("RX",RX1,434))
  1.  W ?21+HOFF,$$CCYY(NCPDP("RX",RX1,434))
  1.  W ?38+HOFF,NCPDP("RX",RX1,435) ; CLAIM REFERENCE I.D.
  1.  W !
  1.  W !
  1. 14 D BILLINFO
  1.  W ?68+HOFF,$$MONEY(NCPDP("RX",RX1,409)) ; INGREDIENT COST SUBMITTED
  1.  W !
  1.  W !
  1. 15 W ?68+HOFF,$$MONEY(NCPDP("RX",RX1,412)) ; DISPENSING FEE SUBMITTED
  1.  W !
  1.  W !
  1. 16 W ?68+HOFF,$$MONEY(NCPDP("RX",RX1,438)) ; INCENTIVE AMOUNT SUBMITTED
  1.  W !
  1. 17 W ?5+HOFF,NCPDP("RX",RX1,402) ; PRESCRIPTION #
  1.  W ?22+HOFF,$$MM(NCPDP("RX",RX1,414)) ; DATE WRITTEN
  1.  W ?25+HOFF,$$DD(NCPDP("RX",RX1,414))
  1.  W ?28+HOFF,$$CCYY(NCPDP("RX",RX1,414))
  1.  W ?33+HOFF,$$MM(NCPDP("RX",RX1,401)) ; DATE FILLED
  1.  W ?36+HOFF,$$DD(NCPDP("RX",RX1,401))
  1.  W ?39+HOFF,$$CCYY(NCPDP("RX",RX1,401))
  1.  W ?44+HOFF,$J(NCPDP("RX",RX1,403),2) ; REFILL #
  1.  W ?47+HOFF,$$QTY(NCPDP("RX",RX1,442)) ; QUANTITY
  1.  W ?59+HOFF,$J(NCPDP("RX",RX1,405),3) ; DAYS SUPPLY
  1.  W !
  1. 18 I ABSP("RX",RX1,"RX IEN") D
  1.  . W ?5+HOFF,$P(^PSRX(ABSP("RX",RX1,"RX IEN"),0),U)
  1.  W ?68+HOFF ; OTHER AMOUNT SUBMITTED
  1.  W !
  1.  W !
  1. 19 W ?68+HOFF,$$MONEY(NCPDP("RX",RX1,410)) ; SALES TAX
  1.  W !
  1. 20 W ?5+HOFF,NCPDP("RX",RX1,407) ; PRODUCT/SERVICE I.D. (NDC #)
  1.  W ?27+HOFF,NCPDP("RX",RX1,408) ; DAW
  1.  W ?31+HOFF,$$PANUM(NCPDP("RX",RX1,416)) ; PRIOR AUTH #
  1.  W ?42+HOFF,$$PATYP(NCPDP("RX",RX1,416))
  1.  W ?46+HOFF,NCPDP("RX",RX1,411) ; PRESCRIBER I.D.
  1.  W !
  1.  W ?5+HOFF,$E($P($G(^PSDRUG(+$G(ABSP("RX",RX1,"Drug IEN")),0)),U),1,40)
  1.  W ?46+HOFF,$E($P($G(^VA(200,ABSP("RX",RX1,"Prescriber IEN"),0)),U),1,20)
  1.  W ?68+HOFF,$$MONEY($$GROSSAMT(RX1))
  1.  W !
  1.  W !
  1. 21 W ?68+HOFF,$$MONEY(NCPDP("RX",RX1,433)) ; PATIENT PAID AMOUNT
  1.  W !
  1. 22 W ?5+HOFF,NCPDP("RX",RX1,439) ; DUR CODES
  1.  W ?9+HOFF,NCPDP("RX",RX1,440)
  1.  W ?13+HOFF,NCPDP("RX",RX1,441)
  1.  W ?17+HOFF,NCPDP("RX",RX1,423) ; BASIS OF COST DETERMINATION
  1.  W ?20+HOFF ; PROVIDER I.D. ?
  1.  W ?38+HOFF,NCPDP("RX",RX1,424) ; DIAGNOSIS CODE
  1.  W !
  1. 23 W ?68+HOFF,$$MONEY(NCPDP("RX",RX1,431)) ; OTHER PAYOR AMOUNT
  1.  W !
  1.  W !
  1. 24 W ?68+HOFF,$$MONEY($$NETAMT(RX1))
  1.  W !
  1.  W ?5+HOFF,$$MM(NCPDP("RX",RX1,443)) ; OTHER PAYOR DATE
  1.  W ?8+HOFF,$$DD(NCPDP("RX",RX1,443))
  1.  W ?11+HOFF,$$CCYY(NCPDP("RX",RX1,443))
  1.  W ?16+HOFF ; OTHER PAYOR I.D.
  1.  W ?29+HOFF ; OTHER PAYOR REJECT CODES
  1.  W ?49,$$MONEY(NCPDP("RX",RX1,426)) ; USUAL & CUSTOMARY AMOUNT
  1.  W !
  1.  W !
  1. 25 ; the second prescription
  1.  I RX2>MAXRXN G 99 ; only one prescription on this page
  1.  W ?68+HOFF,$$MONEY(NCPDP("RX",RX2,409))
  1.  W !
  1.  W !
  1. 26 W ?68+HOFF,$$MONEY(NCPDP("RX",RX2,412))
  1.  W !
  1.  W !
  1.  W ?5+HOFF,NCPDP("RX",RX2,402)
  1.  W ?23+HOFF,$$MM(NCPDP("RX",RX2,414))
  1.  W ?26+HOFF,$$DD(NCPDP("RX",RX2,414))
  1.  W ?29+HOFF,$$CCYY(NCPDP("RX",RX2,414))
  1.  W ?34+HOFF,$$MM(NCPDP("RX",RX2,401))
  1.  W ?37+HOFF,$$DD(NCPDP("RX",RX2,401))
  1.  W ?40+HOFF,$$CCYY(NCPDP("RX",RX2,401))
  1.  W ?44+HOFF,$J(NCPDP("RX",RX2,403),3)
  1.  W ?47+HOFF,$$QTY(NCPDP("RX",RX2,442))
  1.  W ?60+HOFF,$J(NCPDP("RX",RX2,405),3)
  1.  W ?68+HOFF,$$MONEY(NCPDP("RX",RX2,438))
  1.  W !
  1.  I ABSP("RX",RX2,"RX IEN") D
  1.  . W ?5+HOFF,$P(^PSRX(ABSP("RX",RX2,"RX IEN"),0),U)
  1.  W !
  1. 27 W ?68+HOFF ; OTHER AMOUNT SUBMITTED
  1.  W !
  1.  W !
  1. 28 W ?5+HOFF,NCPDP("RX",RX2,407)
  1.  W ?28+HOFF,NCPDP("RX",RX2,408)
  1.  W ?31+HOFF,$$PANUM(NCPDP("RX",RX2,416))
  1.  W ?41+HOFF,$$PATYP(NCPDP("RX",RX2,416))
  1.  W ?46+HOFF,NCPDP("RX",RX2,411)
  1.  W ?68+HOFF,$$MONEY(NCPDP("RX",RX2,410))
  1.  W !
  1.  W ?5+HOFF,$E($P($G(^PSDRUG(+$G(ABSP("RX",RX2,"Drug IEN")),0)),U),1,40)
  1.  W ?46+HOFF,$E($P($G(^VA(200,ABSP("RX",RX2,"Prescriber IEN"),0)),U),1,20)
  1.  W !
  1. 29 W ?68+HOFF,$$MONEY($$GROSSAMT(RX2))
  1.  W !
  1.  W !
  1. 30 W ?5+HOFF,NCPDP("RX",RX2,439)
  1.  W ?8+HOFF,NCPDP("RX",RX2,440)
  1.  W ?11+HOFF,NCPDP("RX",RX2,441)
  1.  W ?18+HOFF,NCPDP("RX",RX2,423)
  1.  W ?21+HOFF ; PROVIDER I.D.
  1.  W ?39+HOFF,NCPDP("RX",RX2,424)
  1.  W ?68+HOFF,$$MONEY(NCPDP("RX",RX2,433))
  1.  W !
  1.  W !
  1. 31 W ?68+HOFF,$$MONEY(NCPDP("RX",RX2,431))
  1.  W !
  1.  W !
  1. 32 W ?5+HOFF,$$MM(NCPDP("RX",RX2,443))
  1.  W ?8+HOFF,$$DD(NCPDP("RX",RX2,443))
  1.  W ?11+HOFF,$$CCYY(NCPDP("RX",RX2,443))
  1.  W ?16+HOFF ; OTHER PAYER I.D.
  1.  W ?31+HOFF ; OTHER PAYER REJECT CODES
  1.  W ?49+HOFF,$$MONEY(NCPDP("RX",RX2,426))
  1.  W ?68+HOFF,$$MONEY($$NETAMT(RX2))
  1.  W !
  1. 99 ;
  1.  Q
  1. MONEY(X) ; format money amount
  1.  I 'X Q "" ; zero amounts - we print nothing
  1.  Q $J(X,8,2) ; 99999.99
  1. MM(D) ; month part of the date
  1.  Q:'D "" Q $E(D,5,6)
  1. DD(D) ; day part of the date
  1.  Q:'D "" Q $E(D,7,8)
  1. CCYY(D) ; year part of the date
  1.  Q:'D "" Q $E(D,1,4)
  1. QTY(Q) ; quantity - metric decimal quantity now
  1.  ; but avoid printing "." unless there is actually a decimal part
  1.  S Q=Q/1000
  1.  I Q#1 Q $J(Q,9,3)
  1.  Q $J(Q,5)_"    "
  1. PANUM(X) ; prior auth # ; first digit is type, second digit undef
  1.  ; then 10 digits for the actual number
  1.  S X=$E(X,3,12)
  1.  Q $S(X:X,1:"") ; return null if it's a great big zero
  1. PATYP(X) Q $S($$PANUM(X):$E(X),1:"") ; return null if number is zero
  1. GROSSAMT(X) ;add it up - don't rely on Gross Amount Due field
  1.  N T S T=0
  1.  N F F F=409,412,438,410 S T=T+NCPDP("RX",X,F)
  1.  Q T
  1. NETAMT(X) ; compute it
  1.  N T S T=0
  1.  S T=$$GROSSAMT(X)
  1.  N F F F=433,431 S T=T-NCPDP("RX",X,F)
  1.  Q T
  1. BILLINFO ;
  1.  N A,B,X S X=ABSP("RX",RX1,"IEN57")
  1.  S A=$P($G(^ABSPTL(X,0)),U,4) ; ILC A/R
  1.  S B=$P($G(^ABSPTL(X,0)),U,15) ; ILC or other A/R
  1.  I A!B D
  1.  . I A S A=$P($G(^ABSBITMS(9002302,A,0)),U)_" `"_A
  1.  . E  S A="`"_B
  1.  . W "Bill #",A
  1.  S A=$P($G(^ABSPTL(X,0)),U,7) ; visit
  1.  I A D
  1.  . S B=$P($G(^AUPNVSIT(A,"VCN")),U)
  1.  . I B]"" W "   VCN ",B
  1.  . E  W "   Visit `",A
  1.  Q