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