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

ABSPOSN6.m

Go to the documentation of this file. 
  1. 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
  1.  ;----------------------------------------------------------------------
  1.  ;IHS/SD/RLT - 11/07/07 - Patch 23
  1.  ; Updated ICD9 call for CSV.
  1.  ;----------------------------------------------------------------------
  1.  ; The form goes from $Y=0 through $Y=20.
  1.  ;
  1.  ; On the LQ-2170 in the Sitka ISD office, on printer SISD1, this
  1.  ; experiment was run on 04/14/2000:
  1.  ; 1. Put leading edge of paper into the tractor feed.
  1.  ; 2. Press PAU F 3 seconds until "beep" tells you that you're
  1.  ;    in micro-adjust mode.
  1.  ; 3. Microadjust down until the absolute top of form is reached.
  1.  ;    It beeps to tell you that it cannot go any farther.
  1.  ; 3a. At this point, you might want to microadjust up a nudge
  1.  ;    because DATE RX(s) written on lines $y=11, $y=13 are
  1.  ;    right in the middle of the blue line.
  1.  ; 4. Press pause to get out of microadjust mode.
  1.  ; 5. D ABSUD102 (the local version, below) four times.
  1.  ;
  1.  ; Results:
  1.  ; $Y=0 line is F group and cardholder ID no.
  1.  ; $Y=2 F the cardholder name line
  1.  ; $Y=3 diagnosis line, where appropriate
  1.  ; PHARmacy name, address, city-state-zip on lines $Y=5,7,9
  1.  ; Tax ID # on $Y=10, just above
  1.  ; PHARmacy # on $Y=11
  1.  ; DATE RX(s) written on $Y=11 (could microadjust down a nudge)
  1.  ; DATE RX(s) filled on $Y=13
  1.  ; Authorized PHARmacy rep also on $Y=13
  1.  ; RX number 1 is on line $Y=16; number 2 is on $Y=18
  1.  ; PATient name on $Y=5 or $Y=6
  1.  ; DOB,Sex,Relationship on $Y=6
  1.  ; Ingre. cost on $Y=8
  1.  ; Disp. fee on $Y=10
  1.  ; Tax on $Y=12
  1.  ; TOTAL PRICE $Y=14
  1.  ; Ded amt $Y=16
  1.  ; Balance $Y=18
  1.  ; $Y=19 is on the bottom blue line, or just below it on the 
  1.  ;   Copyright line - D not U it!
  1.  ; $Y=20 is on perFation or just below it - D NOT U!
  1. PFM ;EP
  1.  N ISAKCAID,NUM
  1.  I PHARINFO("City/State/ZIP")?.E1"AK"." "5N.E,INSINFO("INS. Co. Name")["MEDICAID" S ISAKCAID=1
  1.  E  S ISAKCAID=0
  1.  U IO
  1.  ;
  1.  ; Each of these $Y=n sections ENDs with a "W !"
  1.  ;
  1.  ; $Y=0
  1.  N X
  1.  I ISAKCAID S X=PHARINFO("Medicaid PHARmacy #")
  1.  E  D
  1.  . S X=INSINFO("Group Number")
  1.  . I X="" S X=INSINFO("Group Name")
  1.  W ?9,$E(X,1,15)
  1.  W ?31,$E($G(INSINFO("Cardholder Number")),1,45)
  1.  W !
  1.  ;
  1.  ; $Y=1
  1.  W !
  1.  ;
  1.  ; $Y=2
  1.  W ?6,$E($G(INSINFO("Cardholder Name")),1,33)
  1.  I $G(INSINFO("Other 3rd Party Coverage")) W ?40,"X"
  1.  E  W ?46,"X"
  1.  W !
  1.  ;
  1.  ; $Y=3
  1.  I $$DIAG W $$DIAGINFO
  1.  W !
  1.  ;
  1.  ; $Y=4
  1.  W !
  1.  ;
  1.  ; $Y=5
  1.  W ?5,$E($G(PHARINFO("Name")),1,23)
  1.  W ?29,$S($L($G(PATINFO("Name")))>19:$E($P($G(PATINFO("Name")),",",1),1,18)_",",1:$E($G(PATINFO("Name")),1,19))
  1.  W !
  1.  ;
  1.  ; $Y=6
  1.  W:$L($G(PATINFO("Name")))>19 ?29,$E($P($G(PATINFO("Name")),",",2,999),1,19)
  1.  W ?49,$E($G(PATINFO("DOB")),4,5)
  1.  W ?52,$E($G(PATINFO("DOB")),6,7)
  1.  W ?55,$E($G(PATINFO("DOB")),2,3)
  1.  W:$G(PATINFO("Sex"))="M" ?58,"X"
  1.  W:$G(PATINFO("Sex"))="F" ?60,"X"
  1.  D
  1.  . S X=INSINFO("Relationship")
  1.  . ; old A/R system: you have a pointer to relationship file
  1.  . ; New A/R system: you have 1, 2, 3, 4 already
  1.  . I $D(^ABSBCOMB) D  ; ^ABSBCOMB on purpose, not ^ABSPCOMB
  1.  . . I X'<1,X'>4 W ?X*3+60,"X"
  1.  . E  D
  1.  . . I $D(^AUTTRLSH(X,0)) S X=$P(^(0),U)
  1.  . . I X="SELF" W ?63,"X"
  1.  . . E  I X="SPOUSE" W ?66,"X"
  1.  . . E  I X="HUSBAND" W ?66,"X"
  1.  . . E  I X="WIFE" W ?66,"X"
  1.  . . E  I X="DAUGHTER" W ?69,"X"
  1.  . . E  I X="SON" W ?69,"X"
  1.  . . E  W ?72,"X"
  1.  W !
  1.  ;
  1.  ; $Y=7
  1.  W ?5,$E($G(PHARINFO("Street")),1,23)
  1.  W !
  1.  ;
  1.  ; $Y=8
  1.  W ?29,$E(INSINFO("INS. Co. Name"),1,25)
  1.  ;Ingredient costs
  1.  ;
  1.  W ?56,$J(DRUGINFO(1,"Ingr. Cost"),7,2)
  1.  I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Ingr. Cost"),7,2)
  1.  W !
  1.  ;
  1.  ; $Y=9
  1.  ; 
  1.  W ?5,$E($G(PHARINFO("City/State/ZIP")),1,23)
  1.  W ?29,$E(INSINFO("INS. Co. ADDR 1"),1,25)
  1.  W !
  1.  ;
  1.  ; $Y=10
  1.  ;
  1.  I $$TAXID W ?1,"TaxID# ",PHARINFO("Tax ID #")
  1.  W ?29,$E(INSINFO("INS. Co. ADDR 2"),1,25)
  1.  W ?56,$J(DRUGINFO(1,"Disp. Fee"),7,2)
  1.  I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Disp. Fee"),7,2)
  1.  W !
  1.  ;
  1.  ; $Y=11
  1.  S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,12)
  1.  I ISAKCAID S X=PHARINFO("Medicaid PHARmacy #")
  1.  E  I 'X S X=PHARINFO("PHARmacy #")
  1.  E  I X=1,'$$TAXID S X=PHARINFO("Tax ID #")
  1.  E  I X=2 S X=PHARINFO("Medicaid PHARmacy #") ; this might cHe
  1.  E  S X=PHARINFO("PHARmacy #")
  1.  W ?6,$E(X,1,13)
  1.  W ?20,$E($G(DRUGINFO("DATE Written")),4,5)
  1.  W ?23,$E($G(DRUGINFO("DATE Written")),6,7)
  1.  W ?26,$E($G(DRUGINFO("DATE Written")),2,3)
  1.  W ?29,INSINFO("INS. Co. City/State/Zip")
  1.  W !
  1.  ;
  1.  ; $Y=12
  1.  ; tax would go on this line
  1.  W ?55-$L(DIPA("VCN")),"Patient #" ;*1.26*1*
  1.  W !
  1.  ;
  1.  ; $Y=13
  1.  W ?6,$E($G(PHARINFO("Phone")),1,13)
  1.  W ?20,$E($G(DRUGINFO("DATE Filled")),4,5)
  1.  W ?23,$E($G(DRUGINFO("DATE Filled")),6,7)
  1.  W ?26,$E($G(DRUGINFO("DATE Filled")),2,3)
  1.  W ?31,PHARINFO("Representative")
  1.  S X=DIPA("VCN") W ?55-$L(X),X
  1.  W !
  1.  ;
  1.  ; $Y=14  total price
  1.  ;
  1.  W ?56,$J(DRUGINFO(1,"Total Price"),7,2)
  1.  I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Total Price"),7,2)
  1.  W !
  1.  ;
  1.  ; $Y=15
  1.  ; For some INSurers, print RX 1 DRUG name above the NDC code
  1.  ; actually, START it a little to the left of there
  1.  ;
  1.  I $$DRUGNAME W ?23,DRUGINFO(1,"DRUG Name")
  1.  W !
  1.  ;
  1.  ; $Y=16
  1.  ; Detail F RX 1 and Ded. Amt. in the right hand columns
  1.  W ?4,$E($G(DRUGINFO(1,"RX Number")),1,7)
  1.  W ?12,$E($G(DRUGINFO(1,"N/Refill")),1,2)
  1.  W ?15,$E($G(DRUGINFO(1,"Metric Quantity")),1,5)
  1.  W ?21,$E($G(DRUGINFO(1,"Days Supply")),1,4)
  1.  S DRUGINFO(1,"NDC Code")=$$TRANSNDC(DRUGINFO(1,"NDC Code")) ;*1.26*1*
  1.  I DRUGINFO(1,"NDC Code")?11N D
  1.  .N X S X=DRUGINFO(1,"NDC Code")
  1.  .S X=$E(X,1,5)_"-"_$E(X,6,9)_"-"_$E(X,10,11)
  1.  .S DRUGINFO(1,"NDC Code")=X
  1.  S X=$P($G(DRUGINFO(1,"NDC Code")),"-",1)
  1. NUM S NUM=($L(X)-5) I NUM<0 S X=0_X G NUM
  1.  W ?26,X
  1.  S X=$P($G(DRUGINFO(1,"NDC Code")),"-",2)
  1. NUM4 S NUM=($L(X)-4) I NUM<0 S X=0_X G NUM4
  1.  W ?34,X
  1.  S X=$P($G(DRUGINFO(1,"NDC Code")),"-",3)
  1. NUM2 S NUM=($L(X)-2) I NUM<0 S X=0_X G NUM2
  1.  W ?41,X
  1.  I ISAKCAID S X=DRUGINFO(1,"Presc. Mcaid #")
  1.  E  S X=DRUGINFO(1,"Presc. DEA #")
  1.  W ?44,$E(X,1,8)
  1.  W !
  1.  ;
  1.  ; $Y=17
  1.  I DRUGINFO(0)=2,$$DRUGNAME W ?23,DRUGINFO(2,"DRUG Name")
  1.  W !
  1.  ;
  1.  ; $Y=18
  1.  ; Detail F RX 2 and Balance in the right hand columns
  1. DG2 D:$G(DRUGINFO(0))=2
  1.  .W ?4,$E($G(DRUGINFO(2,"RX Number")),1,7)
  1.  .W ?12,$E($G(DRUGINFO(2,"N/Refill")),1,2)
  1.  .W ?15,$E($G(DRUGINFO(2,"Metric Quantity")),1,5)
  1.  .W ?21,$E($G(DRUGINFO(2,"Days Supply")),1,4)
  1.  .S X=$$TRANSNDC(DRUGINFO(2,"NDC Code")) ; *1.26*1*
  1.  .I X?11N D
  1.  ..S X=$E(X,1,5)_"-"_$E(X,6,9)_"-"_$E(X,10,11)
  1.  ..S DRUGINFO(2,"NDC Code")=X
  1.  .S X=$P($G(DRUGINFO(2,"NDC Code")),"-",1)
  1. NUM1 .S NUM=($L(X)-5) I NUM<0 S X=0_X G NUM1
  1.  .W ?26,X
  1.  .S X=$P($G(DRUGINFO(2,"NDC Code")),"-",2)
  1. NUM5 .S NUM=($L(X)-4) I NUM<0 S X=0_X G NUM5
  1.  .W ?34,X
  1.  .S X=$P($G(DRUGINFO(2,"NDC Code")),"-",3)
  1. NUM3 .S NUM=($L(X)-2) I NUM<0 S X=0_X G NUM3
  1.  .W ?41,X
  1.  .;W ?26,$E($P($G(DRUGINFO(2,"NDC Code")),"-",1),1,5)
  1.  .;W ?34,$E($P($G(DRUGINFO(2,"NDC Code")),"-",2),1,4)
  1.  .;W ?41,$E($P($G(DRUGINFO(2,"NDC Code")),"-",3),1,2)
  1.  .;W ?44,$E($G(DRUGINFO(1,"Prescriber")),1,8)
  1.  .I ISAKCAID S X=DRUGINFO(2,"Presc. Mcaid #")
  1.  .E  S X=DRUGINFO(2,"Presc. DEA #")
  1.  .W ?44,$E(X,1,8)
  1.  W:$G(DRUGINFO(1,"Balance"))'="" ?56,$J(DRUGINFO(1,"Balance"),7,2)
  1.  I DRUGINFO(0)=2 W ?64,$J(DRUGINFO(2,"Balance"),7,2)
  1.  W !
  1.  ;
  1.  ; There is absolutely nothing on these last two lines, but we must
  1.  ; Nline through them in O to position at top of Fm F the
  1.  ; NEXT one.
  1.  ; $Y=19
  1.  W !
  1.  ;
  1.  ; $Y=20
  1.  W !
  1.  Q
  1. TRANSNDC(X) ; Translate NDC code for special cases ; *1.26*1*
  1.  ; output should contain "-" where appropriate
  1.  I ISAKCAID,$TR(X,"-","")="50924055350" Q "A4253-    -  " ; Advantage Test Strips ; *1.26*1*
  1.  Q X
  1. DRUGNAME()         ; Does this INSurer want the DRUG name printed?
  1.  ; We will squeeze it in, but it ain't pretty.
  1.  ;ZW INSINFO,DRUGINFO R ">>>",%,!
  1.  ; first, check F an INSurer-specific setting
  1.  N X S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,9)
  1.  I X]"" Q X
  1.  ; I not present, check the system-wide setting
  1.  S X=$P($G(^ABSP(9002313.99,1,"FMS - NCPDP")),U)
  1.  I X]"" Q X
  1.  ; I not present, the default default is No.
  1.  Q 0
  1. TAXID() ; Does this INSurer want the tax id # printed?
  1.  N X S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,13)
  1.  I X]"" Q X
  1.  ; no INSurer-specific setting, so look F system-wide setting
  1.  S X=$P($G(^ABSP(9002313.99,1,"FMS - NCPDP")),U,4)
  1.  I X]"" Q X
  1.  ; I not present, the default default is No.
  1.  Q 0
  1. DIAG() ; Does this INSurer wnat the diagnosis printed?
  1.  ; first, check an INSurer-specific setting
  1.  N X S X=$P($G(^ABSPEI(INSINFO("IEN"),100)),U,11)
  1.  I X]"" Q X
  1.  ; I not present, check the system-wide setting
  1.  S X=$P($G(^ABSP(9002313.99,1,"FMS - NCPDP")),U,2)
  1.  I X]"" Q X
  1.  ; I not present, the default default is No.
  1.  Q 0
  1. DIAGINFO()         ; return diagnosis INFO to be printed
  1.  N X
  1.  N DIAGCODE S DIAGCODE=$$DIAGCODE(1)
  1.  I DIAGCODE D
  1.  . ;RLT - 11/07/07 - Patch 23
  1.  . ;N % S %=$G(^ICD9(DIAGCODE,0))
  1.  . ;S X=$P(%,U)_" "_$P(%,U,3)
  1.  . N % S %=$$ICDDX^ICDCODE(DIAGCODE)
  1.  . S X=$P(%,U,2)_" "_$P(%,U,4)
  1.  E  S X=""
  1.  Q X
  1. 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?
  1.  ; return pointer to ^ICD9(
  1.  N X S X=$O(^ABSBV(VSTIEN,"FSICD9",0)) I X Q $P(^ABSBV(VSTIEN,"FSICD9",X,0),U)
  1.  N STOP,RET S STOP=0,RET=""
  1.  S X=0 F  S X=$O(^AUPNVPOV("AD",VSTIEN,X)) Q:'X  D  Q:STOP
  1.  . I $P(^AUPNVPOV(X,0),U,12)="P" S RET=$P(^(0),U),STOP=1 Q
  1.  . I RET="" S RET=$P(^AUPNVPOV(X,0),U)
  1.  Q RET
  1. FIX749 ;
  1.  D FIX749A(1)
  1.  I DRUGINFO(0)=2 D FIX749A(2)
  1.  Q
  1. FIX749A(X)         ; cHe dispense fee from $7.49 to $10.00
  1.  Q:DRUGINFO(X,"Disp. Fee")'=7.49
  1.  S DRUGINFO(X,"Disp. Fee")=10
  1.  S DRUGINFO(X,"Total Price")=DRUGINFO(X,"Total Price")-7.49+10
  1.  S DRUGINFO(X,"Balance")=DRUGINFO(X,"Balance")-7.49+10
  1.  Q
  1. ABSUD102 ; temp hack of test pattern
  1.  ; trying to get NCPDP Fms to run on SPAT2 printer
  1.  N POP D ^%ZIS Q:$G(POP)
  1.  U IO
  1.  N I F I=0:1:20 W "$Y=",$Y," " D 1 W !
  1.  D ^%ZISC
  1.  Q
  1. 1 ;
  1.  F  Q:$X>75  D
  1.  . I $X#5=($Y#5) W $X#10
  1.  . E  I $X#1 W "."
  1.  . E  W " "
  1.  Q