ABSPOSN6 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ; [ 09/12/2002 10:16 AM ]
;;1.0;PHARMACY POINT OF SALE;**3,23**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;IHS/SD/RLT - 11/07/07 - Patch 23
; Updated ICD9 call for CSV.
;----------------------------------------------------------------------
; The form goes from $Y=0 through $Y=20.
;
; On the LQ-2170 in the Sitka ISD office, on printer SISD1, this
; experiment was run on 04/14/2000:
; 1. Put leading edge of paper into the tractor feed.
; 2. Press PAU F 3 seconds until "beep" tells you that you're
; in micro-adjust mode.
; 3. Microadjust down until the absolute top of form is reached.
; It beeps to tell you that it cannot go any farther.
; 3a. At this point, you might want to microadjust up a nudge
; because DATE RX(s) written on lines $y=11, $y=13 are
; right in the middle of the blue line.
; 4. Press pause to get out of microadjust mode.
; 5. D ABSUD102 (the local version, below) four times.
;
; Results:
; $Y=0 line is F group and cardholder ID no.
; $Y=2 F the cardholder name line
; $Y=3 diagnosis line, where appropriate
; PHARmacy name, address, city-state-zip on lines $Y=5,7,9
; Tax ID # on $Y=10, just above
; PHARmacy # on $Y=11
; DATE RX(s) written on $Y=11 (could microadjust down a nudge)
; DATE RX(s) filled on $Y=13
; Authorized PHARmacy rep also on $Y=13
; RX number 1 is on line $Y=16; number 2 is on $Y=18
; PATient name on $Y=5 or $Y=6
; DOB,Sex,Relationship on $Y=6
; Ingre. cost on $Y=8
; Disp. fee on $Y=10
; Tax on $Y=12
; TOTAL PRICE $Y=14
; Ded amt $Y=16
; Balance $Y=18
; $Y=19 is on the bottom blue line, or just below it on the
; Copyright line - D not U it!
; $Y=20 is on perFation or just below it - D NOT U!
PFM ;EP
N ISAKCAID,NUM
I PHARINFO("City/State/ZIP")?.E1"AK"." "5N.E,INSINFO("INS. Co. Name")["MEDICAID" S ISAKCAID=1
E S ISAKCAID=0
U IO
;
; Each of these $Y=n sections ENDs with a "W !"
;
; $Y=0
N X
I ISAKCAID S X=PHARINFO("Medicaid PHARmacy #")
E D
. S X=INSINFO("Group Number")
. I X="" S X=INSINFO("Group Name")
W ?9,$E(X,1,15)
W ?31,$E($G(INSINFO("Cardholder Number")),1,45)
W !
;
; $Y=1
W !
;
; $Y=2
W ?6,$E($G(INSINFO("Cardholder Name")),1,33)
I $G(INSINFO("Other 3rd Party Coverage")) W ?40,"X"
E W ?46,"X"
W !
;
; $Y=3
I $$DIAG W $$DIAGINFO
W !
;
; $Y=4
W !
;
; $Y=5
W ?5,$E($G(PHARINFO("Name")),1,23)
W ?29,$S($L($G(PATINFO("Name")))>19:$E($P($G(PATINFO("Name")),",",1),1,18)_",",1:$E($G(PATINFO("Name")),1,19))
W !
;
; $Y=6
W:$L($G(PATINFO("Name")))>19 ?29,$E($P($G(PATINFO("Name")),",",2,999),1,19)
W ?49,$E($G(PATINFO("DOB")),4,5)
W ?52,$E($G(PATINFO("DOB")),6,7)
W ?55,$E($G(PATINFO("DOB")),2,3)
W:$G(PATINFO("Sex"))="M" ?58,"X"
W:$G(PATINFO("Sex"))="F" ?60,"X"
D
. S X=INSINFO("Relationship")
. ; old A/R system: you have a pointer to relationship file
. ; New A/R system: you have 1, 2, 3, 4 already
. I $D(^ABSBCOMB) D ; ^ABSBCOMB on purpose, not ^ABSPCOMB
. . I X'<1,X'>4 W ?X*3+60,"X"
. E D
. . I $D(^AUTTRLSH(X,0)) S X=$P(^(0),U)
. . I X="SELF" W ?63,"X"
. . E I X="SPOUSE" W ?66,"X"
. . E I X="HUSBAND" W ?66,"X"
. . E I X="WIFE" W ?66,"X"
. . E I X="DAUGHTER" W ?69,"X"
. . E I X="SON" W ?69,"X"
. . E W ?72,"X"
W !
;
; $Y=7
W ?5,$E($G(PHARINFO("Street")),1,23)
W !
;
; $Y=8
W ?29,$E(INSINFO("INS. Co. Name"),1,25)
;Ingredient costs
;
W ?56,$J(DRUGINFO(1,"Ingr. Cost"),7,2)
I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Ingr. Cost"),7,2)
W !
;
; $Y=9
;
W ?5,$E($G(PHARINFO("City/State/ZIP")),1,23)
W ?29,$E(INSINFO("INS. Co. ADDR 1"),1,25)
W !
;
; $Y=10
;
I $$TAXID W ?1,"TaxID# ",PHARINFO("Tax ID #")
W ?29,$E(INSINFO("INS. Co. ADDR 2"),1,25)
W ?56,$J(DRUGINFO(1,"Disp. Fee"),7,2)
I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Disp. Fee"),7,2)
W !
;
; $Y=11
S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,12)
I ISAKCAID S X=PHARINFO("Medicaid PHARmacy #")
E I 'X S X=PHARINFO("PHARmacy #")
E I X=1,'$$TAXID S X=PHARINFO("Tax ID #")
E I X=2 S X=PHARINFO("Medicaid PHARmacy #") ; this might cHe
E S X=PHARINFO("PHARmacy #")
W ?6,$E(X,1,13)
W ?20,$E($G(DRUGINFO("DATE Written")),4,5)
W ?23,$E($G(DRUGINFO("DATE Written")),6,7)
W ?26,$E($G(DRUGINFO("DATE Written")),2,3)
W ?29,INSINFO("INS. Co. City/State/Zip")
W !
;
; $Y=12
; tax would go on this line
W ?55-$L(DIPA("VCN")),"Patient #" ;*1.26*1*
W !
;
; $Y=13
W ?6,$E($G(PHARINFO("Phone")),1,13)
W ?20,$E($G(DRUGINFO("DATE Filled")),4,5)
W ?23,$E($G(DRUGINFO("DATE Filled")),6,7)
W ?26,$E($G(DRUGINFO("DATE Filled")),2,3)
W ?31,PHARINFO("Representative")
S X=DIPA("VCN") W ?55-$L(X),X
W !
;
; $Y=14 total price
;
W ?56,$J(DRUGINFO(1,"Total Price"),7,2)
I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Total Price"),7,2)
W !
;
; $Y=15
; For some INSurers, print RX 1 DRUG name above the NDC code
; actually, START it a little to the left of there
;
I $$DRUGNAME W ?23,DRUGINFO(1,"DRUG Name")
W !
;
; $Y=16
; Detail F RX 1 and Ded. Amt. in the right hand columns
W ?4,$E($G(DRUGINFO(1,"RX Number")),1,7)
W ?12,$E($G(DRUGINFO(1,"N/Refill")),1,2)
W ?15,$E($G(DRUGINFO(1,"Metric Quantity")),1,5)
W ?21,$E($G(DRUGINFO(1,"Days Supply")),1,4)
S DRUGINFO(1,"NDC Code")=$$TRANSNDC(DRUGINFO(1,"NDC Code")) ;*1.26*1*
I DRUGINFO(1,"NDC Code")?11N D
.N X S X=DRUGINFO(1,"NDC Code")
.S X=$E(X,1,5)_"-"_$E(X,6,9)_"-"_$E(X,10,11)
.S DRUGINFO(1,"NDC Code")=X
S X=$P($G(DRUGINFO(1,"NDC Code")),"-",1)
NUM S NUM=($L(X)-5) I NUM<0 S X=0_X G NUM
W ?26,X
S X=$P($G(DRUGINFO(1,"NDC Code")),"-",2)
NUM4 S NUM=($L(X)-4) I NUM<0 S X=0_X G NUM4
W ?34,X
S X=$P($G(DRUGINFO(1,"NDC Code")),"-",3)
NUM2 S NUM=($L(X)-2) I NUM<0 S X=0_X G NUM2
W ?41,X
I ISAKCAID S X=DRUGINFO(1,"Presc. Mcaid #")
E S X=DRUGINFO(1,"Presc. DEA #")
W ?44,$E(X,1,8)
W !
;
; $Y=17
I DRUGINFO(0)=2,$$DRUGNAME W ?23,DRUGINFO(2,"DRUG Name")
W !
;
; $Y=18
; Detail F RX 2 and Balance in the right hand columns
DG2 D:$G(DRUGINFO(0))=2
.W ?4,$E($G(DRUGINFO(2,"RX Number")),1,7)
.W ?12,$E($G(DRUGINFO(2,"N/Refill")),1,2)
.W ?15,$E($G(DRUGINFO(2,"Metric Quantity")),1,5)
.W ?21,$E($G(DRUGINFO(2,"Days Supply")),1,4)
.S X=$$TRANSNDC(DRUGINFO(2,"NDC Code")) ; *1.26*1*
.I X?11N D
..S X=$E(X,1,5)_"-"_$E(X,6,9)_"-"_$E(X,10,11)
..S DRUGINFO(2,"NDC Code")=X
.S X=$P($G(DRUGINFO(2,"NDC Code")),"-",1)
NUM1 .S NUM=($L(X)-5) I NUM<0 S X=0_X G NUM1
.W ?26,X
.S X=$P($G(DRUGINFO(2,"NDC Code")),"-",2)
NUM5 .S NUM=($L(X)-4) I NUM<0 S X=0_X G NUM5
.W ?34,X
.S X=$P($G(DRUGINFO(2,"NDC Code")),"-",3)
NUM3 .S NUM=($L(X)-2) I NUM<0 S X=0_X G NUM3
.W ?41,X
.;W ?26,$E($P($G(DRUGINFO(2,"NDC Code")),"-",1),1,5)
.;W ?34,$E($P($G(DRUGINFO(2,"NDC Code")),"-",2),1,4)
.;W ?41,$E($P($G(DRUGINFO(2,"NDC Code")),"-",3),1,2)
.;W ?44,$E($G(DRUGINFO(1,"Prescriber")),1,8)
.I ISAKCAID S X=DRUGINFO(2,"Presc. Mcaid #")
.E S X=DRUGINFO(2,"Presc. DEA #")
.W ?44,$E(X,1,8)
W:$G(DRUGINFO(1,"Balance"))'="" ?56,$J(DRUGINFO(1,"Balance"),7,2)
I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Balance"),7,2)
W !
;
; There is absolutely nothing on these last two lines, but we must
; Nline through them in O to position at top of Fm F the
; NEXT one.
; $Y=19
W !
;
; $Y=20
W !
Q
TRANSNDC(X) ; Translate NDC code for special cases ; *1.26*1*
; output should contain "-" where appropriate
I ISAKCAID,$TR(X,"-","")="50924055350" Q "A4253- - " ; Advantage Test Strips ; *1.26*1*
Q X
DRUGNAME() ; Does this INSurer want the DRUG name printed?
; We will squeeze it in, but it ain't pretty.
;ZW INSINFO,DRUGINFO R ">>>",%,!
; first, check F an INSurer-specific setting
N X S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,9)
I X]"" Q X
; I not present, check the system-wide setting
S X=$P($G(^ABSP(9002313.99,1,"FMS - NCPDP")),U)
I X]"" Q X
; I not present, the default default is No.
Q 0
TAXID() ; Does this INSurer want the tax id # printed?
N X S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,13)
I X]"" Q X
; no INSurer-specific setting, so look F system-wide setting
S X=$P($G(^ABSP(9002313.99,1,"FMS - NCPDP")),U,4)
I X]"" Q X
; I not present, the default default is No.
Q 0
DIAG() ; Does this INSurer wnat the diagnosis printed?
; first, check an INSurer-specific setting
N X S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,11)
I X]"" Q X
; I not present, check the system-wide setting
S X=$P($G(^ABSP(9002313.99,1,"FMS - NCPDP")),U,2)
I X]"" Q X
; I not present, the default default is No.
Q 0
DIAGINFO() ; return diagnosis INFO to be printed
N X
N DIAGCODE S DIAGCODE=$$DIAGCODE(1)
I DIAGCODE D
. ;RLT - 11/07/07 - Patch 23
. ;N % S %=$G(^ICD9(DIAGCODE,0))
. ;S X=$P(%,U)_" "_$P(%,U,3)
. N % S %=$$ICDDX^ICDCODE(DIAGCODE)
. S X=$P(%,U,2)_" "_$P(%,U,4)
E S X=""
Q X
DIAGCODE(N) ; right now, just get FSI BILLING DIAGNOSIS else primary diag
; from V POV else first V POV - how mmany times has this been re/written?
; return pointer to ^ICD9(
N X S X=$O(^ABSBV(VSTIEN,"FSICD9",0)) I X Q $P(^ABSBV(VSTIEN,"FSICD9",X,0),U)
N STOP,RET S STOP=0,RET=""
S X=0 F S X=$O(^AUPNVPOV("AD",VSTIEN,X)) Q:'X D Q:STOP
. I $P(^AUPNVPOV(X,0),U,12)="P" S RET=$P(^(0),U),STOP=1 Q
. I RET="" S RET=$P(^AUPNVPOV(X,0),U)
Q RET
FIX749 ;
D FIX749A(1)
I DRUGINFO(0)=2 D FIX749A(2)
Q
FIX749A(X) ; cHe dispense fee from $7.49 to $10.00
Q:DRUGINFO(X,"Disp. Fee")'=7.49
S DRUGINFO(X,"Disp. Fee")=10
S DRUGINFO(X,"Total Price")=DRUGINFO(X,"Total Price")-7.49+10
S DRUGINFO(X,"Balance")=DRUGINFO(X,"Balance")-7.49+10
Q
ABSUD102 ; temp hack of test pattern
; trying to get NCPDP Fms to run on SPAT2 printer
N POP D ^%ZIS Q:$G(POP)
U IO
N I F I=0:1:20 W "$Y=",$Y," " D 1 W !
D ^%ZISC
Q
1 ;
F Q:$X>75 D
. I $X#5=($Y#5) W $X#10
. E I $X#1 W "."
. E W " "
Q
ABSPOSN6 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ; [ 09/12/2002 10:16 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3,23**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;IHS/SD/RLT - 11/07/07 - Patch 23
+4 ; Updated ICD9 call for CSV.
+5 ;----------------------------------------------------------------------
+6 ; The form goes from $Y=0 through $Y=20.
+7 ;
+8 ; On the LQ-2170 in the Sitka ISD office, on printer SISD1, this
+9 ; experiment was run on 04/14/2000:
+10 ; 1. Put leading edge of paper into the tractor feed.
+11 ; 2. Press PAU F 3 seconds until "beep" tells you that you're
+12 ; in micro-adjust mode.
+13 ; 3. Microadjust down until the absolute top of form is reached.
+14 ; It beeps to tell you that it cannot go any farther.
+15 ; 3a. At this point, you might want to microadjust up a nudge
+16 ; because DATE RX(s) written on lines $y=11, $y=13 are
+17 ; right in the middle of the blue line.
+18 ; 4. Press pause to get out of microadjust mode.
+19 ; 5. D ABSUD102 (the local version, below) four times.
+20 ;
+21 ; Results:
+22 ; $Y=0 line is F group and cardholder ID no.
+23 ; $Y=2 F the cardholder name line
+24 ; $Y=3 diagnosis line, where appropriate
+25 ; PHARmacy name, address, city-state-zip on lines $Y=5,7,9
+26 ; Tax ID # on $Y=10, just above
+27 ; PHARmacy # on $Y=11
+28 ; DATE RX(s) written on $Y=11 (could microadjust down a nudge)
+29 ; DATE RX(s) filled on $Y=13
+30 ; Authorized PHARmacy rep also on $Y=13
+31 ; RX number 1 is on line $Y=16; number 2 is on $Y=18
+32 ; PATient name on $Y=5 or $Y=6
+33 ; DOB,Sex,Relationship on $Y=6
+34 ; Ingre. cost on $Y=8
+35 ; Disp. fee on $Y=10
+36 ; Tax on $Y=12
+37 ; TOTAL PRICE $Y=14
+38 ; Ded amt $Y=16
+39 ; Balance $Y=18
+40 ; $Y=19 is on the bottom blue line, or just below it on the
+41 ; Copyright line - D not U it!
+42 ; $Y=20 is on perFation or just below it - D NOT U!
PFM ;EP
+1 NEW ISAKCAID,NUM
+2 IF PHARINFO("City/State/ZIP")?.E1"AK"." "5N.E
IF INSINFO("INS. Co. Name")["MEDICAID"
SET ISAKCAID=1
+3 IF '$TEST
SET ISAKCAID=0
+4 USE IO
+5 ;
+6 ; Each of these $Y=n sections ENDs with a "W !"
+7 ;
+8 ; $Y=0
+9 NEW X
+10 IF ISAKCAID
SET X=PHARINFO("Medicaid PHARmacy #")
+11 IF '$TEST
Begin DoDot:1
+12 SET X=INSINFO("Group Number")
+13 IF X=""
SET X=INSINFO("Group Name")
End DoDot:1
+14 WRITE ?9,$EXTRACT(X,1,15)
+15 WRITE ?31,$EXTRACT($GET(INSINFO("Cardholder Number")),1,45)
+16 WRITE !
+17 ;
+18 ; $Y=1
+19 WRITE !
+20 ;
+21 ; $Y=2
+22 WRITE ?6,$EXTRACT($GET(INSINFO("Cardholder Name")),1,33)
+23 IF $GET(INSINFO("Other 3rd Party Coverage"))
WRITE ?40,"X"
+24 IF '$TEST
WRITE ?46,"X"
+25 WRITE !
+26 ;
+27 ; $Y=3
+28 IF $$DIAG
WRITE $$DIAGINFO
+29 WRITE !
+30 ;
+31 ; $Y=4
+32 WRITE !
+33 ;
+34 ; $Y=5
+35 WRITE ?5,$EXTRACT($GET(PHARINFO("Name")),1,23)
+36 WRITE ?29,$SELECT($LENGTH($GET(PATINFO("Name")))>19:$EXTRACT($PIECE($GET(PATINFO("Name")),",",1),1,18)_",",1:$EXTRACT($GET(PATINFO("Name")),1,19))
+37 WRITE !
+38 ;
+39 ; $Y=6
+40 IF $LENGTH($GET(PATINFO("Name")))>19
WRITE ?29,$EXTRACT($PIECE($GET(PATINFO("Name")),",",2,999),1,19)
+41 WRITE ?49,$EXTRACT($GET(PATINFO("DOB")),4,5)
+42 WRITE ?52,$EXTRACT($GET(PATINFO("DOB")),6,7)
+43 WRITE ?55,$EXTRACT($GET(PATINFO("DOB")),2,3)
+44 IF $GET(PATINFO("Sex"))="M"
WRITE ?58,"X"
+45 IF $GET(PATINFO("Sex"))="F"
WRITE ?60,"X"
+46 Begin DoDot:1
+47 SET X=INSINFO("Relationship")
+48 ; old A/R system: you have a pointer to relationship file
+49 ; New A/R system: you have 1, 2, 3, 4 already
+50 ; ^ABSBCOMB on purpose, not ^ABSPCOMB
IF $DATA(^ABSBCOMB)
Begin DoDot:2
+51 IF X'<1
IF X'>4
WRITE ?X*3+60,"X"
End DoDot:2
+52 IF '$TEST
Begin DoDot:2
+53 IF $DATA(^AUTTRLSH(X,0))
SET X=$PIECE(^(0),U)
+54 IF X="SELF"
WRITE ?63,"X"
+55 IF '$TEST
IF X="SPOUSE"
WRITE ?66,"X"
+56 IF '$TEST
IF X="HUSBAND"
WRITE ?66,"X"
+57 IF '$TEST
IF X="WIFE"
WRITE ?66,"X"
+58 IF '$TEST
IF X="DAUGHTER"
WRITE ?69,"X"
+59 IF '$TEST
IF X="SON"
WRITE ?69,"X"
+60 IF '$TEST
WRITE ?72,"X"
End DoDot:2
End DoDot:1
+61 WRITE !
+62 ;
+63 ; $Y=7
+64 WRITE ?5,$EXTRACT($GET(PHARINFO("Street")),1,23)
+65 WRITE !
+66 ;
+67 ; $Y=8
+68 WRITE ?29,$EXTRACT(INSINFO("INS. Co. Name"),1,25)
+69 ;Ingredient costs
+70 ;
+71 WRITE ?56,$JUSTIFY(DRUGINFO(1,"Ingr. Cost"),7,2)
+72 IF DRUGINFO(0)=2
WRITE ?64,$JUSTIFY(DRUGINFO(2,"Ingr. Cost"),7,2)
+73 WRITE !
+74 ;
+75 ; $Y=9
+76 ;
+77 WRITE ?5,$EXTRACT($GET(PHARINFO("City/State/ZIP")),1,23)
+78 WRITE ?29,$EXTRACT(INSINFO("INS. Co. ADDR 1"),1,25)
+79 WRITE !
+80 ;
+81 ; $Y=10
+82 ;
+83 IF $$TAXID
WRITE ?1,"TaxID# ",PHARINFO("Tax ID #")
+84 WRITE ?29,$EXTRACT(INSINFO("INS. Co. ADDR 2"),1,25)
+85 WRITE ?56,$JUSTIFY(DRUGINFO(1,"Disp. Fee"),7,2)
+86 IF DRUGINFO(0)=2
WRITE ?64,$JUSTIFY(DRUGINFO(2,"Disp. Fee"),7,2)
+87 WRITE !
+88 ;
+89 ; $Y=11
+90 SET X=$PIECE($GET(^ABSPEI(INSINFO("IEN"),100)),U,12)
+91 IF ISAKCAID
SET X=PHARINFO("Medicaid PHARmacy #")
+92 IF '$TEST
IF 'X
SET X=PHARINFO("PHARmacy #")
+93 IF '$TEST
IF X=1
IF '$$TAXID
SET X=PHARINFO("Tax ID #")
+94 ; this might cHe
IF '$TEST
IF X=2
SET X=PHARINFO("Medicaid PHARmacy #")
+95 IF '$TEST
SET X=PHARINFO("PHARmacy #")
+96 WRITE ?6,$EXTRACT(X,1,13)
+97 WRITE ?20,$EXTRACT($GET(DRUGINFO("DATE Written")),4,5)
+98 WRITE ?23,$EXTRACT($GET(DRUGINFO("DATE Written")),6,7)
+99 WRITE ?26,$EXTRACT($GET(DRUGINFO("DATE Written")),2,3)
+100 WRITE ?29,INSINFO("INS. Co. City/State/Zip")
+101 WRITE !
+102 ;
+103 ; $Y=12
+104 ; tax would go on this line
+105 ;*1.26*1*
WRITE ?55-$LENGTH(DIPA("VCN")),"Patient #"
+106 WRITE !
+107 ;
+108 ; $Y=13
+109 WRITE ?6,$EXTRACT($GET(PHARINFO("Phone")),1,13)
+110 WRITE ?20,$EXTRACT($GET(DRUGINFO("DATE Filled")),4,5)
+111 WRITE ?23,$EXTRACT($GET(DRUGINFO("DATE Filled")),6,7)
+112 WRITE ?26,$EXTRACT($GET(DRUGINFO("DATE Filled")),2,3)
+113 WRITE ?31,PHARINFO("Representative")
+114 SET X=DIPA("VCN")
WRITE ?55-$LENGTH(X),X
+115 WRITE !
+116 ;
+117 ; $Y=14 total price
+118 ;
+119 WRITE ?56,$JUSTIFY(DRUGINFO(1,"Total Price"),7,2)
+120 IF DRUGINFO(0)=2
WRITE ?64,$JUSTIFY(DRUGINFO(2,"Total Price"),7,2)
+121 WRITE !
+122 ;
+123 ; $Y=15
+124 ; For some INSurers, print RX 1 DRUG name above the NDC code
+125 ; actually, START it a little to the left of there
+126 ;
+127 IF $$DRUGNAME
WRITE ?23,DRUGINFO(1,"DRUG Name")
+128 WRITE !
+129 ;
+130 ; $Y=16
+131 ; Detail F RX 1 and Ded. Amt. in the right hand columns
+132 WRITE ?4,$EXTRACT($GET(DRUGINFO(1,"RX Number")),1,7)
+133 WRITE ?12,$EXTRACT($GET(DRUGINFO(1,"N/Refill")),1,2)
+134 WRITE ?15,$EXTRACT($GET(DRUGINFO(1,"Metric Quantity")),1,5)
+135 WRITE ?21,$EXTRACT($GET(DRUGINFO(1,"Days Supply")),1,4)
+136 ;*1.26*1*
SET DRUGINFO(1,"NDC Code")=$$TRANSNDC(DRUGINFO(1,"NDC Code"))
+137 IF DRUGINFO(1,"NDC Code")?11N
Begin DoDot:1
+138 NEW X
SET X=DRUGINFO(1,"NDC Code")
+139 SET X=$EXTRACT(X,1,5)_"-"_$EXTRACT(X,6,9)_"-"_$EXTRACT(X,10,11)
+140 SET DRUGINFO(1,"NDC Code")=X
End DoDot:1
+141 SET X=$PIECE($GET(DRUGINFO(1,"NDC Code")),"-",1)
NUM SET NUM=($LENGTH(X)-5)
IF NUM<0
SET X=0_X
GOTO NUM
+1 WRITE ?26,X
+2 SET X=$PIECE($GET(DRUGINFO(1,"NDC Code")),"-",2)
NUM4 SET NUM=($LENGTH(X)-4)
IF NUM<0
SET X=0_X
GOTO NUM4
+1 WRITE ?34,X
+2 SET X=$PIECE($GET(DRUGINFO(1,"NDC Code")),"-",3)
NUM2 SET NUM=($LENGTH(X)-2)
IF NUM<0
SET X=0_X
GOTO NUM2
+1 WRITE ?41,X
+2 IF ISAKCAID
SET X=DRUGINFO(1,"Presc. Mcaid #")
+3 IF '$TEST
SET X=DRUGINFO(1,"Presc. DEA #")
+4 WRITE ?44,$EXTRACT(X,1,8)
+5 WRITE !
+6 ;
+7 ; $Y=17
+8 IF DRUGINFO(0)=2
IF $$DRUGNAME
WRITE ?23,DRUGINFO(2,"DRUG Name")
+9 WRITE !
+10 ;
+11 ; $Y=18
+12 ; Detail F RX 2 and Balance in the right hand columns
DG2 IF $GET(DRUGINFO(0))=2
Begin DoDot:1
+1 WRITE ?4,$EXTRACT($GET(DRUGINFO(2,"RX Number")),1,7)
+2 WRITE ?12,$EXTRACT($GET(DRUGINFO(2,"N/Refill")),1,2)
+3 WRITE ?15,$EXTRACT($GET(DRUGINFO(2,"Metric Quantity")),1,5)
+4 WRITE ?21,$EXTRACT($GET(DRUGINFO(2,"Days Supply")),1,4)
+5 ; *1.26*1*
SET X=$$TRANSNDC(DRUGINFO(2,"NDC Code"))
+6 IF X?11N
Begin DoDot:2
+7 SET X=$EXTRACT(X,1,5)_"-"_$EXTRACT(X,6,9)_"-"_$EXTRACT(X,10,11)
+8 SET DRUGINFO(2,"NDC Code")=X
End DoDot:2
+9 SET X=$PIECE($GET(DRUGINFO(2,"NDC Code")),"-",1)
NUM1 SET NUM=($LENGTH(X)-5)
IF NUM<0
SET X=0_X
GOTO NUM1
+1 WRITE ?26,X
+2 SET X=$PIECE($GET(DRUGINFO(2,"NDC Code")),"-",2)
NUM5 SET NUM=($LENGTH(X)-4)
IF NUM<0
SET X=0_X
GOTO NUM5
+1 WRITE ?34,X
+2 SET X=$PIECE($GET(DRUGINFO(2,"NDC Code")),"-",3)
NUM3 SET NUM=($LENGTH(X)-2)
IF NUM<0
SET X=0_X
GOTO NUM3
+1 WRITE ?41,X
+2 ;W ?26,$E($P($G(DRUGINFO(2,"NDC Code")),"-",1),1,5)
+3 ;W ?34,$E($P($G(DRUGINFO(2,"NDC Code")),"-",2),1,4)
+4 ;W ?41,$E($P($G(DRUGINFO(2,"NDC Code")),"-",3),1,2)
+5 ;W ?44,$E($G(DRUGINFO(1,"Prescriber")),1,8)
+6 IF ISAKCAID
SET X=DRUGINFO(2,"Presc. Mcaid #")
+7 IF '$TEST
SET X=DRUGINFO(2,"Presc. DEA #")
+8 WRITE ?44,$EXTRACT(X,1,8)
End DoDot:1
+9 IF $GET(DRUGINFO(1,"Balance"))'=""
WRITE ?56,$JUSTIFY(DRUGINFO(1,"Balance"),7,2)
+10 IF DRUGINFO(0)=2
WRITE ?64,$JUSTIFY(DRUGINFO(2,"Balance"),7,2)
+11 WRITE !
+12 ;
+13 ; There is absolutely nothing on these last two lines, but we must
+14 ; Nline through them in O to position at top of Fm F the
+15 ; NEXT one.
+16 ; $Y=19
+17 WRITE !
+18 ;
+19 ; $Y=20
+20 WRITE !
+21 QUIT
TRANSNDC(X) ; Translate NDC code for special cases ; *1.26*1*
+1 ; output should contain "-" where appropriate
+2 ; Advantage Test Strips ; *1.26*1*
IF ISAKCAID
IF $TRANSLATE(X,"-","")="50924055350"
QUIT "A4253- - "
+3 QUIT X
DRUGNAME() ; Does this INSurer want the DRUG name printed?
+1 ; We will squeeze it in, but it ain't pretty.
+2 ;ZW INSINFO,DRUGINFO R ">>>",%,!
+3 ; first, check F an INSurer-specific setting
+4 NEW X
SET X=$PIECE($GET(^ABSPEI(INSINFO("IEN"),100)),U,9)
+5 IF X]""
QUIT X
+6 ; I not present, check the system-wide setting
+7 SET X=$PIECE($GET(^ABSP(9002313.99,1,"FMS - NCPDP")),U)
+8 IF X]""
QUIT X
+9 ; I not present, the default default is No.
+10 QUIT 0
TAXID() ; Does this INSurer want the tax id # printed?
+1 NEW X
SET X=$PIECE($GET(^ABSPEI(INSINFO("IEN"),100)),U,13)
+2 IF X]""
QUIT X
+3 ; no INSurer-specific setting, so look F system-wide setting
+4 SET X=$PIECE($GET(^ABSP(9002313.99,1,"FMS - NCPDP")),U,4)
+5 IF X]""
QUIT X
+6 ; I not present, the default default is No.
+7 QUIT 0
DIAG() ; Does this INSurer wnat the diagnosis printed?
+1 ; first, check an INSurer-specific setting
+2 NEW X
SET X=$PIECE($GET(^ABSPEI(INSINFO("IEN"),100)),U,11)
+3 IF X]""
QUIT X
+4 ; I not present, check the system-wide setting
+5 SET X=$PIECE($GET(^ABSP(9002313.99,1,"FMS - NCPDP")),U,2)
+6 IF X]""
QUIT X
+7 ; I not present, the default default is No.
+8 QUIT 0
DIAGINFO() ; return diagnosis INFO to be printed
+1 NEW X
+2 NEW DIAGCODE
SET DIAGCODE=$$DIAGCODE(1)
+3 IF DIAGCODE
Begin DoDot:1
+4 ;RLT - 11/07/07 - Patch 23
+5 ;N % S %=$G(^ICD9(DIAGCODE,0))
+6 ;S X=$P(%,U)_" "_$P(%,U,3)
+7 NEW %
SET %=$$ICDDX^ICDCODE(DIAGCODE)
+8 SET X=$PIECE(%,U,2)_" "_$PIECE(%,U,4)
End DoDot:1
+9 IF '$TEST
SET X=""
+10 QUIT X
DIAGCODE(N) ; right now, just get FSI BILLING DIAGNOSIS else primary diag
+1 ; from V POV else first V POV - how mmany times has this been re/written?
+2 ; return pointer to ^ICD9(
+3 NEW X
SET X=$ORDER(^ABSBV(VSTIEN,"FSICD9",0))
IF X
QUIT $PIECE(^ABSBV(VSTIEN,"FSICD9",X,0),U)
+4 NEW STOP,RET
SET STOP=0
SET RET=""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VSTIEN,X))
IF 'X
QUIT
Begin DoDot:1
+6 IF $PIECE(^AUPNVPOV(X,0),U,12)="P"
SET RET=$PIECE(^(0),U)
SET STOP=1
QUIT
+7 IF RET=""
SET RET=$PIECE(^AUPNVPOV(X,0),U)
End DoDot:1
IF STOP
QUIT
+8 QUIT RET
FIX749 ;
+1 DO FIX749A(1)
+2 IF DRUGINFO(0)=2
DO FIX749A(2)
+3 QUIT
FIX749A(X) ; cHe dispense fee from $7.49 to $10.00
+1 IF DRUGINFO(X,"Disp. Fee")'=7.49
QUIT
+2 SET DRUGINFO(X,"Disp. Fee")=10
+3 SET DRUGINFO(X,"Total Price")=DRUGINFO(X,"Total Price")-7.49+10
+4 SET DRUGINFO(X,"Balance")=DRUGINFO(X,"Balance")-7.49+10
+5 QUIT
ABSUD102 ; temp hack of test pattern
+1 ; trying to get NCPDP Fms to run on SPAT2 printer
+2 NEW POP
DO ^%ZIS
IF $GET(POP)
QUIT
+3 USE IO
+4 NEW I
FOR I=0:1:20
WRITE "$Y=",$Y," "
DO 1
WRITE !
+5 DO ^%ZISC
+6 QUIT
1 ;
+1 FOR
IF $X>75
QUIT
Begin DoDot:1
+2 IF $X#5=($Y#5)
WRITE $X#10
+3 IF '$TEST
IF $X#1
WRITE "."
+4 IF '$TEST
WRITE " "
End DoDot:1
+5 QUIT
