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

ABSPOSQQ.m

Go to the documentation of this file. 
  1. ABSPOSQQ ; IHS/FCS/DRS - VTL 05:51 PM 20 Jan 1997 ;   
  1.  ;;1.0;PHARMACY POINT OF SALE;**17,18,40,41**;JUN 21, 2001;Build 38
  1.  Q
  1.  ; billable/unbillable drugs  ; called from ABSPOSQA from ABSPOSQ1
  1.  ;  $$BILLABLE() to determine if the drug is billable
  1.  ;   Parameters are all optional, so long as you provide at least one.
  1.  ;  INSIEN = pointer to insurance
  1.  ;  DRUGIEN = pointer to drug file
  1.  ;  NDC = NDC #, 11 digits
  1.  ;
  1.  ;   Name comparisons are done non-case sensitive.
  1.  ;   If the NDC number is given and the AWP-MED TRANSACTION file is
  1.  ;   present, then that name is used for testing as well as the drug
  1.  ;   name.  (Two name tests are run.)
  1.  ;
  1.  ;  Return value:  result^result text
  1.  ;     result = 1 billable or 0 not billable
  1.  ;
  1.  ;---------------------------------------------------------------
  1.  ;IHS/SD/RLT - 04/07/06 - Patch 17
  1.  ;                        Added drug name display to SETNDC.
  1.  ;---------------------------------------------------------------
  1.  ;IHS/SD/RLT - 09/01/06 - Patch 18
  1.  ;                        Fixed OTC UNBILLABE for insurers
  1.  ;                        in tag SETOTC.
  1.  ;---------------------------------------------------------------
  1.  ;IHS/OIT/CNI/RAN - Patch 40 - Rewrote entire BILLABLE subroutine to fix logic issues
  1. BILLABLE(INSIEN,DRUGIEN,NDC) ;EP - ABSPOSQA
  1.  N RESULT
  1.  I '$G(INSIEN) S RESULT="1^no insurance goes through as billable" Q RESULT
  1.  N X S X=$P($G(^AUTNINS(INSIEN,0)),U)
  1.  I X="" S RESULT="1^INSIEN="_INSIEN_" not found in ^AUTNINS?" Q RESULT
  1.  I X?1"SELF"0.1" PAY" S RESULT="1^SELF PAY goes through as billable" Q RESULT
  1.  N DRUGNAME,MEDTNAME
  1.  I $G(DRUGIEN) S DRUGNAME=$P(^PSDRUG(DRUGIEN,0),U)
  1.  E  S DRUGNAME=""
  1.  I $D(NDC),NDC]"" D
  1.  . N X S X=$O(^APSAMDF("B",NDC,0))
  1.  . I X S MEDTNAME=$P(^APSAMDF(X,2),U)
  1.  . E  S MEDTNAME=""
  1.  E  S NDC="",MEDTNAME=""
  1.  ;
  1.  ;First check insurance level...
  1.  ;NDC first
  1.  S RESULT=$$GETNDC(INSIEN,DRUGIEN,NDC,9002313.4,0)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  S RESULT=$$GETNDC(INSIEN,DRUGIEN,NDC,9002313.4,1)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  ;Now Drug Name
  1.  S RESULT=$$GETDRNAM(INSIEN,DRUGIEN,DRUGNAME,MEDTNAME,9002313.4,0)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  S RESULT=$$GETDRNAM(INSIEN,DRUGIEN,DRUGNAME,MEDTNAME,9002313.4,1)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  ;Next check system wide settings for same
  1.  ;NDC first
  1.  S RESULT=$$GETNDC(1,DRUGIEN,NDC,9002313.99,0)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  S RESULT=$$GETNDC(1,DRUGIEN,NDC,9002313.99,1)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  ;Now Drug Name
  1.  S RESULT=$$GETDRNAM(1,DRUGIEN,DRUGNAME,MEDTNAME,9002313.99,0)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  S RESULT=$$GETDRNAM(1,DRUGIEN,DRUGNAME,MEDTNAME,9002313.99,1)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  ;Then OTC Check Insurance level first
  1.  S RESULT=$$GETOTC(INSIEN,DRUGIEN,9002313.4,0)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  S RESULT=$$GETOTC(INSIEN,DRUGIEN,9002313.4,1)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  ;Then system level
  1.  S RESULT=$$GETOTC(1,DRUGIEN,9002313.99,0)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  S RESULT=$$GETOTC(1,DRUGIEN,9002313.99,1)
  1.  I ($P(RESULT,U,1)=1)!($P(RESULT,U,1)=0) Q RESULT
  1.  ;If we got this far...there are no rules prohibiting this...so it's billable
  1.  S RESULT=1
  1.  Q RESULT
  1. GETNDC(INSIEN,DRUGIEN,NDC,FILE,FOR) ;CHECK FOR NDC RULES
  1.  N ROOT,SUB,SUBNDC,SUBNAME,RESULT
  1.  S RESULT=""
  1.  S ROOT=^DIC(FILE,0,"GL")_INSIEN_")"
  1.  S SUB=$S(FOR:"",1:"UN")_"BILLABLE"
  1.  S SUBNDC=SUB_" NDC #"
  1.  I NDC]"",$D(@ROOT@(SUBNDC,"B",NDC)) D  Q RESULT
  1.  . S $P(RESULT,U)=FOR ; mark it as unbillable or billable
  1.  . N X S X=$P(RESULT,U,2) ; previous commentary
  1.  . I X]"" S X=X_"; " ; separate the pieces
  1.  . S X=X_"NDC "_NDC_" is "_$S(FOR:"",1:"un")_"billable "_$$HOW(FILE)
  1.  . S $P(RESULT,U,2)=X
  1.  Q RESULT
  1.  ;
  1. GETDRNAM(INSIEN,DRUGIEN,DRUGNAME,MEDTNAME,FILE,FOR) ;CHECK FOR DRUG NAME RULES
  1.  N ROOT,SUB,SUBNDC,SUBNAME,NAME,RESULT
  1.  S RESULT=""
  1.  ;IHS/OIT/CASSEVER/RAN - 02/07/2011 - patch 41 Should check based on file, not just hardcoded insurance file
  1.  ;S ROOT=^DIC(9002313.4,0,"GL")_INSIEN_")"
  1.  S ROOT=^DIC(FILE,0,"GL")_INSIEN_")"
  1.  S SUB=$S(FOR:"",1:"UN")_"BILLABLE"
  1.  S SUBNAME=SUB_" DRUG NAME"
  1.  F NAME=DRUGNAME,MEDTNAME I NAME]"" I $$NAMETEST D  Q
  1.  . S $P(RESULT,U)=FOR
  1.  . N X S X=$P(RESULT,U,2) S:X]"" X=X_"; "
  1.  . S X=X_"Drug "_NAME_" is "_$S(FOR:"",1:"un")_"billable "_$$HOW(FILE)
  1.  . S $P(RESULT,U,2)=X
  1.  Q RESULT
  1.  ;
  1. GETOTC(INSIEN,DRUGIEN,FILE,FOR) ;CHECK FOR OTC RULES
  1.  N ROOT,SUB,SUBNDC,SUBNAME,RESULT
  1.  S ROOT=^DIC(FILE,0,"GL")_INSIEN_")"
  1.  S SUB=$S(FOR:"",1:"UN")_"BILLABLE"
  1.  S SUBNDC=SUB_" NDC #",SUBNAME=SUB_" DRUG NAME"
  1.  S RESULT=""
  1.  I $G(DRUGIEN),$P(^PSDRUG(DRUGIEN,0),U,3)["9" D
  1.  . N OTC S OTC=$P($G(@ROOT@("UNBILLABLE OTC")),U)
  1.  . I OTC="" Q  ; not specified, so don't alter result
  1.  . ; OTC=1 if unbillable, =0 if billable
  1.  . I OTC]"" S OTC='OTC ; =1 if billable, 0 if not billable
  1.  . I OTC=FOR D
  1.  . . S $P(RESULT,U)=FOR
  1.  . . N X S X=$P(RESULT,U,2) S:X]"" X=X_"; "
  1.  . . S X="OTCs are "_$S(FOR:"",1:"un")_"billable "_$$HOW(FILE)
  1.  . . S $P(RESULT,U,2)=X
  1.  Q RESULT
  1.  ;
  1. NAMETEST() ; Execute the tests in order; stop when you get a TRUE result
  1.  ; Given NAME - return value is 1 if any test was TRUE, 0 if all FALSE
  1.  ; and SUBNAME needed too
  1.  I '$O(@ROOT@(SUBNAME,0)) Q 0 ; quick out for when no rules are there
  1.  N ABSBPOS2,DOLLART,X S (DOLLART,ABSBPOS2)=0
  1.  ; the tests are in terms of a variable X; assumed to be uppercase
  1.  S X=$TR(NAME,"qwertyuiopasdfghjklzxcvbnm","QWERTYUIOPASDFGHJKLZXCVBNM")
  1.  F  S ABSBPOS2=$O(@ROOT@(SUBNAME,ABSBPOS2)) Q:'ABSBPOS2  D  Q:DOLLART
  1.  . X @ROOT@(SUBNAME,ABSBPOS2,0) S DOLLART=$T
  1.  Q DOLLART
  1. HOW(FILE)          I FILE=9002313.99 Q "for all companies"
  1.  I FILE=9002313.4 Q "for "_$P(^AUTNINS(INSIEN,0),U)
  1.  Q "HOW^"_$T(+0)_"??"
  1.  ; Interactive routines
  1.  ; Entry point:  set OTC field, system-wide (9002313.99)
  1. SETOTC ;EP - option ABSP UNBILLABLE OTC
  1.  W !!,"This setting determines whether OTC drugs are UNbillable.",!
  1.  W "First, the default setting which applies to all insurances:",!
  1.  N DIE,DR,DA,DUOUT,DTOUT,DIC,Y,X,DINUM,DLAYGO,DTIME
  1.  S DIE=9002313.99,DA=1,DR=2128.13 D ^DIE
  1.  ;
  1.  W !!,"Next, you may make any insurer-specific settings.  This is",!
  1.  W "for situations where an insurer has a different policy on OTCs.",!
  1.  F  S (DIC,DLAYGO)=9002313.4,DIC(0)="AE" D ^DIC Q:Y<1  D
  1.  . ;IHS/SD/RLT - 9/1/06 - Patch 18
  1.  . ;S DA=+Y,DR=2128.13 D ^DIE
  1.  . S DIE=9002313.4,DA=+Y,DR=2128.13 D ^DIE   ;write to ABSP INSURER file
  1.  Q
  1. SETNAME ;EP - option ABSP UNBILLABLE DRUG ; the name-based rules
  1.  I DUZ(0)'["@" D  Q
  1.  . W !,"You have to have a programmer enter these rules.",!
  1.  N DIE,DR,DA,DUOUT,DTOUT,DIC,Y,X,DINUM,DLAYGO,DTIME
  1.  W !!?15,"*****  Name-based rules for billable insurances  *****",!
  1.  W "Enter Mumps IF commands to set $T true or false",!
  1.  W "(True means Unbillable if you're entering Unbillable rules;",!
  1.  W " True means Billable   if you're entering Billable   rules)",!
  1.  W "The variable X contains the drug name, converted to uppercase.",!
  1.  W !!?5,"**  First, the system-wide defaults:  **",!
  1.  S DIE=9002313.99,DA=1,DR=2128.12 D ^DIE
  1.  W !!?5,"**  Rules for specific insurances  **",!
  1.  D NOTE
  1.  F  S (DIC,DLAYGO)=9002313.4,DIC(0)="AE" D ^DIC Q:Y<1  D
  1.  . S DIE=9002313.4,DA=+Y,DR=2128.12 D ^DIE
  1.  . S DR=228.12 D ^DIE
  1.  . W !!
  1.  Q
  1. NOTE ;
  1.  W "(Note:  if the system-wide rule says the drug is billable,",!
  1.  W " then only the insurer's unbillable test is made,",!
  1.  W " and conversely, if the system-wide test says unbillable",!
  1.  W " then only the insurer's billable test is made.)",!
  1.  Q
  1. SETNDC ;EP - option ABSP UNBILLABLE NDC ; the NDC number rules
  1.  N DIE,DR,DA,DUOUT,DTOUT,DIC,Y,X,DINUM,DLAYGO,DTIME
  1.  N NEWREC,INSIEN      ;RLT
  1.  W !!,"*****  Specifying unbillable and billable NDC numbers",!!
  1.  W "The numbers you enter must be 11-digit numbers, without dashes.",!!
  1.  W "First, NDC numbers that are unbillable, system-wide",!
  1.  ;IHS/SD/RLT - 04/27/06 - Patch 17 - BEGIN PART 1
  1.  ;S DIE=9002313.99,DA=1,DR=2128.11 D ^DIE
  1.  F  D  Q:X=""!($G(DTOUT))!($G(DUOUT))
  1.  . D ^XBFMK       ;kill FileMan variables
  1.  . S DA(1)=1
  1.  . S DIC="^ABSP(9002313.99,"_DA(1)_",""UNBILLABLE NDC #"","
  1.  . S DIC(0)="AELMQZ"
  1.  . S DIC("W")="D GETNAME^ABSPOSQQ(1)"
  1.  . D ^DIC
  1.  . S NEWREC=$P(Y,U,3)
  1.  . I Y>0&('$G(DTOUT))&('$G(DUOUT))&('NEWREC) D
  1.  . . S DIE="^ABSP(9002313.99,"_DA(1)_",""UNBILLABLE NDC #"","
  1.  . . S DA=+Y
  1.  . . S DR=.01
  1.  . . D ^DIE
  1.  ;IHS/SD/RLT - 04/27/06 - Patch 17 - END PART 1
  1.  W !!,"Now, NDC numbers that are unbillable/billable",!
  1.  W "for specific insurers",!
  1.  D NOTE
  1.  ;IHS/SD/RLT - 04/07/06 - Patch 17 - BEGIN PART 2
  1.  D ^XBFMK       ;kill FileMan variables
  1.  F  S (DIC,DLAYGO)=9002313.4,DIC(0)="AE" D ^DIC Q:Y<1  D
  1.  . ;S DIE=9002313.4,DA=+Y,DR="2128.11;228.11" D ^DIE
  1.  . S INSIEN=+Y
  1.  . F  D  Q:X=""!($G(DTOUT))!($G(DUOUT))
  1.  . . D ^XBFMK       ;kill FileMan variables
  1.  . . S DA(1)=INSIEN
  1.  . . S DIC="^ABSPEI("_DA(1)_",""UNBILLABLE NDC #"","
  1.  . . S DIC(0)="AELMQZ"
  1.  . . S DIC("W")="D GETNAME^ABSPOSQQ(2)"
  1.  . . D ^DIC
  1.  . . S NEWREC=$P(Y,U,3)
  1.  . . I Y>0&('$G(DTOUT))&('$G(DUOUT))&('NEWREC) D
  1.  . . . S DIE="^ABSPEI("_DA(1)_",""UNBILLABLE NDC #"","
  1.  . . . S DA=+Y
  1.  . . . S DR=.01
  1.  . . . D ^DIE
  1.  . F  D  Q:X=""!($G(DTOUT))!($G(DUOUT))
  1.  . . D ^XBFMK
  1.  . . S DA(1)=INSIEN
  1.  . . S DIC="^ABSPEI("_DA(1)_",""BILLABLE NDC #"","
  1.  . . S DIC(0)="AELMQZ"
  1.  . . S DIC("W")="D GETNAME^ABSPOSQQ(3)"
  1.  . . D ^DIC
  1.  . . S NEWREC=$P(Y,U,3)
  1.  . . I Y>0&('$G(DTOUT))&('$G(DUOUT))&('NEWREC) D
  1.  . . . S DIE="^ABSPEI("_DA(1)_",""BILLABLE NDC #"","
  1.  . . . S DA=+Y
  1.  . . . S DR=.01
  1.  . . . D ^DIE
  1.  ;IHS/SD/RLT - 04/07/06 - Patch 17 - END PART 2
  1.  Q
  1. GETNAME(TAG) ;
  1.  ;IHS/SD/RLT - 04/07/06 - Patch 17 - BEGIN PART 3
  1.  N NDC,NDCIEN,DRUGNAME
  1.  S:TAG=1 NDC=$P($G(^ABSP(9002313.99,DA(1),"UNBILLABLE NDC #",Y,0)),U)
  1.  S:TAG=2 NDC=$P($G(^ABSPEI(DA(1),"UNBILLABLE NDC #",Y,0)),U)
  1.  S:TAG=3 NDC=$P($G(^ABSPEI(DA(1),"BILLABLE NDC #",Y,0)),U)
  1.  S NDCIEN=$O(^APSAMDF("B",NDC,0))
  1.  S:NDCIEN="" DRUGNAME="NDC NOT FOUND IN AWP TRANSACTION FILE"
  1.  S:NDCIEN'="" DRUGNAME=$P($G(^APSAMDF(NDCIEN,2)),U)
  1.  W DRUGNAME
  1.  Q
  1.  ;IHS/SD/RLT - 04/07/06 - Patch 17 - END PART 3
  1. ANYSET(N) ;EP - are any of the billable/unbillable fields set for 
  1.  ; ^ABSPEI(N ?
  1.  ;  Used by computed field 2128.99
  1.  I $P($G(^ABSPEI(N,"UNBILLABLE OTC")),U)]"" Q 1
  1.  N RET,X,Y S RET=0
  1.  F X="","UN" F Y="DRUG NAME","NDC #" D
  1.  . I $O(^ABSPEI(N,X_"BILLABLE "_Y,0)) S RET=1
  1.  Q RET