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