ABSPICPY.m

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