ABSPICPY ; IHS/OIT/CASSevern/Pieran ran 9/19/2011 - Copy Insurance default Profiles
;;1.0;PHARMACY POINT OF SALE;**42,46,48,49**;JUN 21, 2001;Build 38
;
; This routine will be called when creating a new ABSP INSURER so that a "sane" set of defaults can be loaded for a good chance at working without modification.
; Basically we will prompt the user as to whether it's a Medicaid, Medicare or Commercial insurer...go to the appropriate table and add the defaults stored in that table.
; We'll start out with a default table that is applicable to all of the above and then go from there.
EN(ABSPINS) ;EP
N OK,TYP
S OK=0
;NEXT 5 LINES FOR PROMPTING USER...NO LONGER NEEDED
;F Q:OK D
;. W !,"Is this Insurer a 1.) Medicaid, 2.) Medicare or 3.) Private Insurer?"
;. R !,"Enter 1, 2, 3, or ""^"" to exit. ",INP
;. I ((+INP>0)&&(+INP<4))||(INP="^") S OK=1 ;They must enter a 1, 2, 3 or "^" otherwise prompt again.
;. ELSE W !,"That is not a valid choice, please enter ""1"", ""2"", ""3"", or ""^"""
;Instead of prompting them...we'll get the insurance type off the main insurer file
;M** and R are Medicare
;D is Medicaid
;P is private, but for the purposes of this copy program, we'll treat any value that isn't M, R or D as private
; S TYP=$P($G(^AUTNINS(ABSPINS,2)),"^")
S TYP=$$INSTYP^AGUTL(ABSPINS) ; USE NEW API TO GET INSURER TYPE.
S TYP=$S(TYP="D":1,TYP="M":2,TYP="R":2,TYP="MD":2,TYP="MH":2,TYP="MC":2,TYP="MMC":2,1:3) ; SET UP DEFAULTS DEPENDING ON INSURER TYPE.
D PROCESS(ABSPINS,TYP)
Q
PROCESS(ABSPINS,TYP) ;Process the INSURER here
N INS,ABSPSPEC,ABSPSPSG,ABSPSPFL,ZERR ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
D DEFCOPY(ABSPINS) ;The defaults get loaded regardless of insurance type
D:TYP=1 CAIDCOPY(ABSPINS)
D:TYP=2 CARECOPY(ABSPINS)
D:TYP=3 PRIVCOPY(ABSPINS)
; D:$D(INS(1)) UPDATE^DIE("E","INS(1)")
D:$D(INS(1)) UPDATE^DIE("E","INS(1)",,"ZERR") ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
I $D(ZERR) D LOG^ABSPOSL2("PROCESS^ABSPICPY",.ZERR) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
D:$D(ABSPSPEC) POPSPEC(ABSPINS,.ABSPSPEC)
D:$D(ABSPSPSG) POPSEG(ABSPINS,.ABSPSPSG)
D:$D(ABSPSPFL) POPFLD(ABSPINS,.ABSPSPFL)
Q
DEFCOPY(ABSPINS) ;Read through the DEFTAB table and load those settings
N L,LINE
F L=1:1 Q:$P($T(DEFTAB+L),";",3)="***" D
. S LINE=$T(DEFTAB+L)
. D RDLINE(LINE,ABSPINS)
Q
CAIDCOPY(ABSPINS) ;Read through the CAIDTAB table and load those settings
N L,LINE
F L=1:1 Q:$P($T(CAIDTAB+L),";",3)="***" D
. S LINE=$T(CAIDTAB+L)
. D RDLINE(LINE,ABSPINS)
Q
CARECOPY(ABSPINS) ;Read through the CARETAB table and load those settings
N L,LINE
F L=1:1 Q:$P($T(CARETAB+L),";",3)="***" D
. S LINE=$T(CARETAB+L)
. D RDLINE(LINE,ABSPINS)
Q
PRIVCOPY(ABSPINS) ;Read through the PRIVTAB table and load those settings
N L,LINE
F L=1:1 Q:$P($T(PRIVTAB+L),";",3)="***" D
. S LINE=$T(PRIVTAB+L)
. D RDLINE(LINE,ABSPINS)
Q
RDLINE(LINE,ABSPINS) ;Go through the line and populate the array
N TYPE,FLDNUM,VAL,FILE
S FILE=1 I $D(^ABSPEI(ABSPINS,210))!($D(^ABSPEI(ABSPINS,221)))!($D(^ABSPEI(ABSPINS,220))) S FILE=0
S TYPE=$P(LINE,";",3)
S NCPDPCD=$P(LINE,";",4)
S VAL=$P(LINE,";",6)
I TYPE="SPEC" S ABSPSPEC(NCPDPCD)=VAL
I TYPE="SEG" S ABSPSPSG(VAL)=""
I TYPE="FLD" S ABSPSPFL(NCPDPCD)=""
I TYPE="TOP",FILE S INS(1,9002313.4,ABSPINS_",",NCPDPCD)=VAL
Q
;Tables use following setup:
;;TYPE;NCPDP FIELD #;COMMENT;VALUE
; If TYPE="SPEC" put the actual special code you want to put into the NCPDP code in "VALUE"
; I.e. ;;SPEC;302;FIELD 302;S ABSP("X")="01" (Puts the special code `S ABSP(X)=1` into NCPDP field 302
; If TYPE="SEG" put the Segment # in Value...
; I.e. ;;SEG;;CompounD Segment;10 (suppresses the compound segment....piece 5 is just to make it easier to debug)
; Segment #s are:
; 2 = Suppress Provider Segment
; 5 = Suppress COB Segment
; 6 = Suppress Workers Comp Segment
; 8 = Suppress DURR/PPS Segment
; 9 = Suppress Coupon Segment
; 10= Suppress Compound Segment
; 12= Suppress Prior Auth Segment
; 13= Suppress Clinical Segment
; 14= Suppress Additional Doc Segment
; 15= Suppress Facility Segment
; 16= Suppress Narrative Segment
; If TYPE="FLD" the correct NCPDP field number needs to be in piece 4
; I.e. ;;FLD;308;Field 308; (Suppresses field 308...Again piece 5 is not required but makes it easier to debug)
; If TYPE="TOP" put the Fileman field number in instead of NCPDP #
; I.e. ;;TOP;100.18;Medicare Part D?;Y (Put's "Y" in the field Medicare Part D?)
; Field numbers are:
; 100.18="Medicare Part D?"
; 100.19="Maximum number of RXs per claim"
; 100.2="Add Dispensing fee to ingredeant cost"
; 100.3="Contract required"
; 100.4="Total exclusive of Patient Amount"
; (Values are all either "Y" or "N" except for "Maximum number of RXs per claim")
DEFTAB ;;TYPE;NCPDP FIELD #;FIELD NAME;VALUE
;;FLD;354;SUPPRESS FIELD 354;
;;FLD;357;SUPPRESS FIELD 357;
;;FLD;391;SUPPRESS FIELD 391;
;;FLD;995;SUPPRESS FIELD 995;
;;FLD;996;SUPPRESS FIELD 996;
;;FLD;420;SUPPRESS FIELD 420;
;;FLD;458;SUPPRESS FIELD 458;
;;FLD;459;SUPPRESS FIELD 459;
;;FLD;494;SUPPRESS FIELD 494;
;;FLD;495;SUPPRESS FIELD 495;
;;FLD;496;SUPPRESS FIELD 496;
;;FLD;497;SUPPRESS FIELD 497;
;;FLD;499;SUPPRESS FIELD 499;
;;FLD;524;SUPPRESS FIELD 524;
;;FLD;359;SUPPRESS FIELD 359;
;;FLD;360;SUPPRESS FIELD 360;
;;FLD;361;SUPPRESS FIELD 361;
;;FLD;997;SUPPRESS FIELD 997;
;;FLD;115;SUPPRESS FIELD 115;
;;FLD;350;SUPPRESS FIELD 350;
;;FLD;334;SUPPRESS FIELD 334;
;;FLD;498;SUPPRESS FIELD 498;
;;FLD;364;SUPPRESS FIELD 364;
;;FLD;365;SUPPRESS FIELD 365;
;;FLD;366;SUPPRESS FIELD 366;
;;FLD;367;SUPPRESS FIELD 367;
;;FLD;368;SUPPRESS FIELD 368;
;;SEG;;COB Segment;5
;;SEG;;Workers Comp Segment;6
;;SEG;;Durr/PPS Segment;8
;;SEG;;Coupon Segment;9
;;SEG;;Compound Segment;10
;;SEG;;Prior Auth Segment;12
;;SEG;;Clinical Segment;13
;;SEG;;Additional Doc Segment;14
;;SEG;;Facility Segment;15
;;SEG;;Narrative Segment;16
;;SPEC;436;PUT SPECIAL CODE IN FIELD 436;S ABSP("X")="03"
;;SPEC;455;PUT SPECIAL CODE IN FIELD 455;S ABSP("X")=1
;;TOP;100.2;Add Dispensing fee to ingredeant cost;N
;;TOP;100.3;Contract required;N
;;TOP;100.4;Total exclusive of Patient Amount;N
;;TOP;100.07;DIAL OUT TO;ENVOY DIRECT VIA T1 LINE
;;TOP;100.14;Insurer NPI Flag;BOTH
;;TOP;100.06;RX-Pricing Method;STANDARD
;;***
Q
CAIDTAB ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
;;FLD;147;SUPPRESS FIELD 147;
;;FLD;384;SUPPRESS FIELD 384;
;;SPEC;304;PUT SPECIAL CODE IN FIELD 304;S ABSP("X")=$G(ABSP("Patient","Medicaid DOB")) S:ABSP("X")="" ABSP("X")=$G(ABSP("Patient","DOB")) S ABSP("X")=$$DTF1|ABSPECFM(ABSP("X"))
;;TOP;100.18;Medicare Part D?;N
;;TOP;100.19;Maximum RXs per claim;4
;;TOP;104.01;RX-Priority;5
;;***
Q
CARETAB ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
;;SPEC;304;PUT SPECIAL CODE IN FIELD 304;S ABSP("X")=$G(ABSP("Patient","Medicare DOB")) S:ABSP("X")="" ABSP("X")=$G(ABSP("Patient","DOB")) S ABSP("X")=$$DTF1|ABSPECFM(ABSP("X"))
;;TOP;100.18;Medicare Part D?;Y
;;TOP;100.19;Maximum RXs per claim;1
;;TOP;104.01;RX-Prioriry;650
;;***
Q
PRIVTAB ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
;;FLD;147;SUPPRESS FIELD 147;
;;FLD;384;SUPPRESS FIELD 384;
;;TOP;100.18;Medicare Part D?;N
;;TOP;100.19;Maximum RXs per claim;4
;;TOP;104.01;RX-Priority;20
;;***
Q
POPSPEC(ABSPINS,ABSPSPEC) ;Now populate the Special Code stuff
;This has already been run...don't add duplicate entries.
Q:$D(^ABSPEI(ABSPINS,210))
N NCPDPCD,INS,STRING,ZERR ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
S NCPDPCD=""
F S NCPDPCD=$O(ABSPSPEC(NCPDPCD)) Q:NCPDPCD="" D
. ;These are the fields that can't be overriden
. Q:(NCPDPCD=111)!(NCPDPCD=103)
. S STRING=$TR(ABSPSPEC(NCPDPCD),"^","|") ;Fileman won't store this string with a ^ (caret) in it
. S INS(1,9002313.42,"+1,"_ABSPINS_",",.01)=NCPDPCD
. S INS(1,9002313.42,"+1,"_ABSPINS_",",.02)=STRING
. ; D UPDATE^DIE("E","INS(1)")
. D UPDATE^DIE("E","INS(1)",,"ZERR") ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
. I $D(ZERR) D LOG^ABSPOSL2("POPSPEC^ABSPICPY",.ZERR) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q
POPSEG(ABSPINS,ABSPSPSG) ;Next we populate the suppressed segments
;This has already been run...don't add duplicate entries.
Q:$D(^ABSPEI(ABSPINS,221))
N SEGCD,INS,ZERR ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
S SEGCD=""
F S SEGCD=$O(ABSPSPSG(SEGCD)) Q:SEGCD="" D
. S INS(1,9002313.48,"+1,"_ABSPINS_",",.01)=SEGCD
. ; D UPDATE^DIE("","INS(1)") ;On this one we are using the Internal value
. D UPDATE^DIE("","INS(1)",,"ZERR") ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
. I $D(ZERR) D LOG^ABSPOSL2("POPSEG^ABSPICPY",.ZERR) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q
POPFLD(ABSPINS,ABSPSPFL) ;Next we populate the suppressed fields
;This has already been run...don't add duplicate entries.
Q:$D(^ABSPEI(ABSPINS,220))
N NCPDPCD,ZERR ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
S NCPDPCD=""
F S NCPDPCD=$O(ABSPSPFL(NCPDPCD)) Q:NCPDPCD="" D
. S INS(1,9002313.46,"+1,"_ABSPINS_",",.01)=NCPDPCD
. ; D UPDATE^DIE("E","INS(1)")
. D UPDATE^DIE("E","INS(1)",,"ZERR") ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
. I $D(ZERR) D LOG^ABSPOSL2("POPFLD^ABSPICPY",.ZERR) ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
Q
ABSPICPY ; IHS/OIT/CASSevern/Pieran ran 9/19/2011 - Copy Insurance default Profiles
+1 ;;1.0;PHARMACY POINT OF SALE;**42,46,48,49**;JUN 21, 2001;Build 38
+2 ;
+3 ; This routine will be called when creating a new ABSP INSURER so that a "sane" set of defaults can be loaded for a good chance at working without modification.
+4 ; Basically we will prompt the user as to whether it's a Medicaid, Medicare or Commercial insurer...go to the appropriate table and add the defaults stored in that table.
+5 ; We'll start out with a default table that is applicable to all of the above and then go from there.
EN(ABSPINS) ;EP
+1 NEW OK,TYP
+2 SET OK=0
+3 ;NEXT 5 LINES FOR PROMPTING USER...NO LONGER NEEDED
+4 ;F Q:OK D
+5 ;. W !,"Is this Insurer a 1.) Medicaid, 2.) Medicare or 3.) Private Insurer?"
+6 ;. R !,"Enter 1, 2, 3, or ""^"" to exit. ",INP
+7 ;. I ((+INP>0)&&(+INP<4))||(INP="^") S OK=1 ;They must enter a 1, 2, 3 or "^" otherwise prompt again.
+8 ;. ELSE W !,"That is not a valid choice, please enter ""1"", ""2"", ""3"", or ""^"""
+9 ;Instead of prompting them...we'll get the insurance type off the main insurer file
+10 ;M** and R are Medicare
+11 ;D is Medicaid
+12 ;P is private, but for the purposes of this copy program, we'll treat any value that isn't M, R or D as private
+13 ; S TYP=$P($G(^AUTNINS(ABSPINS,2)),"^")
+14 ; USE NEW API TO GET INSURER TYPE.
SET TYP=$$INSTYP^AGUTL(ABSPINS)
+15 ; SET UP DEFAULTS DEPENDING ON INSURER TYPE.
SET TYP=$SELECT(TYP="D":1,TYP="M":2,TYP="R":2,TYP="MD":2,TYP="MH":2,TYP="MC":2,TYP="MMC":2,1:3)
+16 DO PROCESS(ABSPINS,TYP)
+17 QUIT
PROCESS(ABSPINS,TYP) ;Process the INSURER here
+1 ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
NEW INS,ABSPSPEC,ABSPSPSG,ABSPSPFL,ZERR
+2 ;The defaults get loaded regardless of insurance type
DO DEFCOPY(ABSPINS)
+3 IF TYP=1
DO CAIDCOPY(ABSPINS)
+4 IF TYP=2
DO CARECOPY(ABSPINS)
+5 IF TYP=3
DO PRIVCOPY(ABSPINS)
+6 ; D:$D(INS(1)) UPDATE^DIE("E","INS(1)")
+7 ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
IF $DATA(INS(1))
DO UPDATE^DIE("E","INS(1)",,"ZERR")
+8 ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("PROCESS^ABSPICPY",.ZERR)
+9 IF $DATA(ABSPSPEC)
DO POPSPEC(ABSPINS,.ABSPSPEC)
+10 IF $DATA(ABSPSPSG)
DO POPSEG(ABSPINS,.ABSPSPSG)
+11 IF $DATA(ABSPSPFL)
DO POPFLD(ABSPINS,.ABSPSPFL)
+12 QUIT
DEFCOPY(ABSPINS) ;Read through the DEFTAB table and load those settings
+1 NEW L,LINE
+2 FOR L=1:1
IF $PIECE($TEXT(DEFTAB+L),";",3)="***"
QUIT
Begin DoDot:1
+3 SET LINE=$TEXT(DEFTAB+L)
+4 DO RDLINE(LINE,ABSPINS)
End DoDot:1
+5 QUIT
CAIDCOPY(ABSPINS) ;Read through the CAIDTAB table and load those settings
+1 NEW L,LINE
+2 FOR L=1:1
IF $PIECE($TEXT(CAIDTAB+L),";",3)="***"
QUIT
Begin DoDot:1
+3 SET LINE=$TEXT(CAIDTAB+L)
+4 DO RDLINE(LINE,ABSPINS)
End DoDot:1
+5 QUIT
CARECOPY(ABSPINS) ;Read through the CARETAB table and load those settings
+1 NEW L,LINE
+2 FOR L=1:1
IF $PIECE($TEXT(CARETAB+L),";",3)="***"
QUIT
Begin DoDot:1
+3 SET LINE=$TEXT(CARETAB+L)
+4 DO RDLINE(LINE,ABSPINS)
End DoDot:1
+5 QUIT
PRIVCOPY(ABSPINS) ;Read through the PRIVTAB table and load those settings
+1 NEW L,LINE
+2 FOR L=1:1
IF $PIECE($TEXT(PRIVTAB+L),";",3)="***"
QUIT
Begin DoDot:1
+3 SET LINE=$TEXT(PRIVTAB+L)
+4 DO RDLINE(LINE,ABSPINS)
End DoDot:1
+5 QUIT
RDLINE(LINE,ABSPINS) ;Go through the line and populate the array
+1 NEW TYPE,FLDNUM,VAL,FILE
+2 SET FILE=1
IF $DATA(^ABSPEI(ABSPINS,210))!($DATA(^ABSPEI(ABSPINS,221)))!($DATA(^ABSPEI(ABSPINS,220)))
SET FILE=0
+3 SET TYPE=$PIECE(LINE,";",3)
+4 SET NCPDPCD=$PIECE(LINE,";",4)
+5 SET VAL=$PIECE(LINE,";",6)
+6 IF TYPE="SPEC"
SET ABSPSPEC(NCPDPCD)=VAL
+7 IF TYPE="SEG"
SET ABSPSPSG(VAL)=""
+8 IF TYPE="FLD"
SET ABSPSPFL(NCPDPCD)=""
+9 IF TYPE="TOP"
IF FILE
SET INS(1,9002313.4,ABSPINS_",",NCPDPCD)=VAL
+10 QUIT
+11 ;Tables use following setup:
+12 ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
+13 ; If TYPE="SPEC" put the actual special code you want to put into the NCPDP code in "VALUE"
+14 ; I.e. ;;SPEC;302;FIELD 302;S ABSP("X")="01" (Puts the special code `S ABSP(X)=1` into NCPDP field 302
+15 ; If TYPE="SEG" put the Segment # in Value...
+16 ; I.e. ;;SEG;;CompounD Segment;10 (suppresses the compound segment....piece 5 is just to make it easier to debug)
+17 ; Segment #s are:
+18 ; 2 = Suppress Provider Segment
+19 ; 5 = Suppress COB Segment
+20 ; 6 = Suppress Workers Comp Segment
+21 ; 8 = Suppress DURR/PPS Segment
+22 ; 9 = Suppress Coupon Segment
+23 ; 10= Suppress Compound Segment
+24 ; 12= Suppress Prior Auth Segment
+25 ; 13= Suppress Clinical Segment
+26 ; 14= Suppress Additional Doc Segment
+27 ; 15= Suppress Facility Segment
+28 ; 16= Suppress Narrative Segment
+29 ; If TYPE="FLD" the correct NCPDP field number needs to be in piece 4
+30 ; I.e. ;;FLD;308;Field 308; (Suppresses field 308...Again piece 5 is not required but makes it easier to debug)
+31 ; If TYPE="TOP" put the Fileman field number in instead of NCPDP #
+32 ; I.e. ;;TOP;100.18;Medicare Part D?;Y (Put's "Y" in the field Medicare Part D?)
+33 ; Field numbers are:
+34 ; 100.18="Medicare Part D?"
+35 ; 100.19="Maximum number of RXs per claim"
+36 ; 100.2="Add Dispensing fee to ingredeant cost"
+37 ; 100.3="Contract required"
+38 ; 100.4="Total exclusive of Patient Amount"
+39 ; (Values are all either "Y" or "N" except for "Maximum number of RXs per claim")
DEFTAB ;;TYPE;NCPDP FIELD #;FIELD NAME;VALUE
+1 ;;FLD;354;SUPPRESS FIELD 354;
+2 ;;FLD;357;SUPPRESS FIELD 357;
+3 ;;FLD;391;SUPPRESS FIELD 391;
+4 ;;FLD;995;SUPPRESS FIELD 995;
+5 ;;FLD;996;SUPPRESS FIELD 996;
+6 ;;FLD;420;SUPPRESS FIELD 420;
+7 ;;FLD;458;SUPPRESS FIELD 458;
+8 ;;FLD;459;SUPPRESS FIELD 459;
+9 ;;FLD;494;SUPPRESS FIELD 494;
+10 ;;FLD;495;SUPPRESS FIELD 495;
+11 ;;FLD;496;SUPPRESS FIELD 496;
+12 ;;FLD;497;SUPPRESS FIELD 497;
+13 ;;FLD;499;SUPPRESS FIELD 499;
+14 ;;FLD;524;SUPPRESS FIELD 524;
+15 ;;FLD;359;SUPPRESS FIELD 359;
+16 ;;FLD;360;SUPPRESS FIELD 360;
+17 ;;FLD;361;SUPPRESS FIELD 361;
+18 ;;FLD;997;SUPPRESS FIELD 997;
+19 ;;FLD;115;SUPPRESS FIELD 115;
+20 ;;FLD;350;SUPPRESS FIELD 350;
+21 ;;FLD;334;SUPPRESS FIELD 334;
+22 ;;FLD;498;SUPPRESS FIELD 498;
+23 ;;FLD;364;SUPPRESS FIELD 364;
+24 ;;FLD;365;SUPPRESS FIELD 365;
+25 ;;FLD;366;SUPPRESS FIELD 366;
+26 ;;FLD;367;SUPPRESS FIELD 367;
+27 ;;FLD;368;SUPPRESS FIELD 368;
+28 ;;SEG;;COB Segment;5
+29 ;;SEG;;Workers Comp Segment;6
+30 ;;SEG;;Durr/PPS Segment;8
+31 ;;SEG;;Coupon Segment;9
+32 ;;SEG;;Compound Segment;10
+33 ;;SEG;;Prior Auth Segment;12
+34 ;;SEG;;Clinical Segment;13
+35 ;;SEG;;Additional Doc Segment;14
+36 ;;SEG;;Facility Segment;15
+37 ;;SEG;;Narrative Segment;16
+38 ;;SPEC;436;PUT SPECIAL CODE IN FIELD 436;S ABSP("X")="03"
+39 ;;SPEC;455;PUT SPECIAL CODE IN FIELD 455;S ABSP("X")=1
+40 ;;TOP;100.2;Add Dispensing fee to ingredeant cost;N
+41 ;;TOP;100.3;Contract required;N
+42 ;;TOP;100.4;Total exclusive of Patient Amount;N
+43 ;;TOP;100.07;DIAL OUT TO;ENVOY DIRECT VIA T1 LINE
+44 ;;TOP;100.14;Insurer NPI Flag;BOTH
+45 ;;TOP;100.06;RX-Pricing Method;STANDARD
+46 ;;***
+47 QUIT
CAIDTAB ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
+1 ;;FLD;147;SUPPRESS FIELD 147;
+2 ;;FLD;384;SUPPRESS FIELD 384;
+3 ;;SPEC;304;PUT SPECIAL CODE IN FIELD 304;S ABSP("X")=$G(ABSP("Patient","Medicaid DOB")) S:ABSP("X")="" ABSP("X")=$G(ABSP("Patient","DOB")) S ABSP("X")=$$DTF1|ABSPECFM(ABSP("X"))
+4 ;;TOP;100.18;Medicare Part D?;N
+5 ;;TOP;100.19;Maximum RXs per claim;4
+6 ;;TOP;104.01;RX-Priority;5
+7 ;;***
+8 QUIT
CARETAB ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
+1 ;;SPEC;304;PUT SPECIAL CODE IN FIELD 304;S ABSP("X")=$G(ABSP("Patient","Medicare DOB")) S:ABSP("X")="" ABSP("X")=$G(ABSP("Patient","DOB")) S ABSP("X")=$$DTF1|ABSPECFM(ABSP("X"))
+2 ;;TOP;100.18;Medicare Part D?;Y
+3 ;;TOP;100.19;Maximum RXs per claim;1
+4 ;;TOP;104.01;RX-Prioriry;650
+5 ;;***
+6 QUIT
PRIVTAB ;;TYPE;NCPDP FIELD #;COMMENT;VALUE
+1 ;;FLD;147;SUPPRESS FIELD 147;
+2 ;;FLD;384;SUPPRESS FIELD 384;
+3 ;;TOP;100.18;Medicare Part D?;N
+4 ;;TOP;100.19;Maximum RXs per claim;4
+5 ;;TOP;104.01;RX-Priority;20
+6 ;;***
+7 QUIT
POPSPEC(ABSPINS,ABSPSPEC) ;Now populate the Special Code stuff
+1 ;This has already been run...don't add duplicate entries.
+2 IF $DATA(^ABSPEI(ABSPINS,210))
QUIT
+3 ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
NEW NCPDPCD,INS,STRING,ZERR
+4 SET NCPDPCD=""
+5 FOR
SET NCPDPCD=$ORDER(ABSPSPEC(NCPDPCD))
IF NCPDPCD=""
QUIT
Begin DoDot:1
+6 ;These are the fields that can't be overriden
+7 IF (NCPDPCD=111)!(NCPDPCD=103)
QUIT
+8 ;Fileman won't store this string with a ^ (caret) in it
SET STRING=$TRANSLATE(ABSPSPEC(NCPDPCD),"^","|")
+9 SET INS(1,9002313.42,"+1,"_ABSPINS_",",.01)=NCPDPCD
+10 SET INS(1,9002313.42,"+1,"_ABSPINS_",",.02)=STRING
+11 ; D UPDATE^DIE("E","INS(1)")
+12 ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
DO UPDATE^DIE("E","INS(1)",,"ZERR")
+13 ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("POPSPEC^ABSPICPY",.ZERR)
End DoDot:1
+14 QUIT
POPSEG(ABSPINS,ABSPSPSG) ;Next we populate the suppressed segments
+1 ;This has already been run...don't add duplicate entries.
+2 IF $DATA(^ABSPEI(ABSPINS,221))
QUIT
+3 ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
NEW SEGCD,INS,ZERR
+4 SET SEGCD=""
+5 FOR
SET SEGCD=$ORDER(ABSPSPSG(SEGCD))
IF SEGCD=""
QUIT
Begin DoDot:1
+6 SET INS(1,9002313.48,"+1,"_ABSPINS_",",.01)=SEGCD
+7 ; D UPDATE^DIE("","INS(1)") ;On this one we are using the Internal value
+8 ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
DO UPDATE^DIE("","INS(1)",,"ZERR")
+9 ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("POPSEG^ABSPICPY",.ZERR)
End DoDot:1
+10 QUIT
POPFLD(ABSPINS,ABSPSPFL) ;Next we populate the suppressed fields
+1 ;This has already been run...don't add duplicate entries.
+2 IF $DATA(^ABSPEI(ABSPINS,220))
QUIT
+3 ; /IHS/OIT/RAM ; 9 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE
NEW NCPDPCD,ZERR
+4 SET NCPDPCD=""
+5 FOR
SET NCPDPCD=$ORDER(ABSPSPFL(NCPDPCD))
IF NCPDPCD=""
QUIT
Begin DoDot:1
+6 SET INS(1,9002313.46,"+1,"_ABSPINS_",",.01)=NCPDPCD
+7 ; D UPDATE^DIE("E","INS(1)")
+8 ; /IHS/OIT/RAM ; 9 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.
DO UPDATE^DIE("E","INS(1)",,"ZERR")
+9 ; /IHS/OIT/RAM ; 9 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
IF $DATA(ZERR)
DO LOG^ABSPOSL2("POPFLD^ABSPICPY",.ZERR)
End DoDot:1
+10 QUIT
