Routine: ABSPOSI7

ABSPOSI7 ; IHS/FCS/DRS - utilities to go with Page 7 ;  [ 08/30/2002  7:20 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38

 ;----------------------------------------------------------

 ;IHS/SD/lwj 8/29/02  NCPDP 5.1 changes

 ; new field added to the insurance/prior authorization screen

 ; to capture the Prior Authorization Type Code.  Changed

 ; ENAB subroutine to enable and disable this field.  The

 ; field will be enabled when the preauthorization code is

 ; enabled, and disabled when the preauth is disable.

 ; The only time the value of this field will be recorded in

 ; the claim is when the format for the claims is 5.1.

 ;----------------------------------------------------------

DOPAGE() ;EP - should we do page 7? Only if one or more of the ques. are enabled

 ; this is used by the BRANCH logic of the NDC/CPT/HCPCS field

 ; to figure whether to set DDSSTACK="THE ASKS"

 ; Actual enabling is done by ENAB

 N DOIT

 I $$DOFIELD(1.01) S DOIT=1 ; insurance

 E  I $$DOFIELD(1.02) S DOIT=1 ; preauth

 E  I $$DOFIELD(1.03) S DOIT=1 ; pricing

 E  S DOIT=0

 Q DOIT

ISCPT() ; non-prescription, CPT code - detected by absence of RXI

 Q $$GET^DDSVAL(DIE,.DA,1.01)=""

DOFIELD(N) ;EP - context: form, page 1, block ABSP PAGE 1 BOTTOM

 ; DIE = "^ABSP(9002313.51,DA(1),2,DA,"

 ; DA(1), DA point to the line item.

 ; But we're looking at the yes/no's at ^ABSP(9002313.51,DA(1),*)

 N RET S RET=$$GET^DDSVAL(9002313.51,DA(1),N)

 ; For insurance, you have to have had lines set up for insurance, too

 I N=1.01,RET S RET=RET&$D(^ABSP(9002313.51,DA(1),2,DA,"I",1))

 ; for pricing, this can't be POSTAGE (it's done on Page 11, not 7)

 I N=1.03 D

 . ; Do not ask pricing for POSTAGE; it has its own pricing page

 . I $$GET^DDSVAL(DIE,.DA,.03)="POSTAGE" S RET=0 Q

 . ; Do ask pricing for CPT codes (detected by absence of RXI)

 . I $$ISCPT S RET=1 Q

 Q RET

ENAB ; enable/disable blocks,fields based on settings in fields 1.01 ff

 ; done on entry to page 7

 D ENAB1(1.01,4,1) ; insurance

 ;IHS/SD/lwj 8/30/02 NCPDP 5.1 changes

 ; A new field for the prior auth type code was needed- to have

 ; the screen flow, the new field, and the existing preauthorization

 ; field were reversed - field 1 is now the type, and field 2 is the

 ; prior auth number (formally preauthorization)

 D ENAB1(1.02,1,2)  ;IHS/SD/lwj 8/30/02 now the prior auth type

 D ENAB1(1.02,2,2)  ;IHS/SD/lwj 8/30/02 this is the prior auth number

 ;IHS/OIT/SCR 11/20/08 modified line to include incentive amount

 ;N F F F=11,12,14 D ENAB1(1.03,F,3) ; qty, unit price, dispense fee

 N F F F=11,12,17,14 D ENAB1(1.03,F,3) ; qty, unit price, dispense fee,incentive amount

 ; set up some pricing defaults if nothing is set up yet

 I $$DOFIELD(1.03),$$GET^DDSVAL(DIE,.DA,5.02)="" D PAGE7^ABSPOSQP

 ; set up some insurance defaults if nothing is set up yet

 I $$DOFIELD(1.01),$$GET^DDSVAL(DIE,.DA,7.01)="" D INIT^ABSPOSI8

ENAB1(ORIG,FIELD,BLOCK,PAGE)         ;EP

 I '$G(PAGE) S PAGE=7

 D UNED^DDSUTL(FIELD,BLOCK,PAGE,'$$DOFIELD(ORIG))

RECALC1 ;EP - from ABSPOSI2,ABSPOSQP

 ; when you change quantity or unit price

 N X S X=$$GET^DDSVAL(DIE,.DA,5.01)

 N Y S Y=$$GET^DDSVAL(DIE,.DA,5.02)

 N Z S Z=X*Y

 S Z=$$ROUND(Z)

 D PUT^DDSVAL(DIE,.DA,5.03,$J(Z,0,2))

 D RECALC2 ; and then that affects the total price

RECALC2 ; when you change dispense fee

 N X S X=$$GET^DDSVAL(DIE,.DA,5.03)

 N Y S Y=$$GET^DDSVAL(DIE,.DA,5.04)

 ;IHS/OIT/SCR 11/20/08

 N ABSPINCT S ABSPINCT=$$GET^DDSVAL(DIE,.DA,5.07)

 ; N Z S Z=X+Y

 N Z S Z=X+Y+ABSPINCT

 S Z=$$ROUND(Z)

 D PUT^DDSVAL(DIE,.DA,5.05,$J(Z,0,2))

ROUND(X) Q X*100+.5\1/100

ABSPOSI7  ; IHS/FCS/DRS - utilities to go with Page 7 ;  [ 08/30/2002  7:20 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38

 +2       ;----------------------------------------------------------

 +3       ;IHS/SD/lwj 8/29/02  NCPDP 5.1 changes

 +4       ; new field added to the insurance/prior authorization screen

 +5       ; to capture the Prior Authorization Type Code.  Changed

 +6       ; ENAB subroutine to enable and disable this field.  The

 +7       ; field will be enabled when the preauthorization code is

 +8       ; enabled, and disabled when the preauth is disable.

 +9       ; The only time the value of this field will be recorded in

 +10      ; the claim is when the format for the claims is 5.1.

 +11      ;----------------------------------------------------------

 +12       QUIT

DOPAGE()  ;EP - should we do page 7? Only if one or more of the ques. are enabled

 +1       ; this is used by the BRANCH logic of the NDC/CPT/HCPCS field

 +2       ; to figure whether to set DDSSTACK="THE ASKS"

 +3       ; Actual enabling is done by ENAB

 +4        NEW DOIT

 +5       ; insurance

           IF $$DOFIELD(1.01)

               SET DOIT=1

 +6       ; preauth

          IF '$TEST

               IF $$DOFIELD(1.02)

                   SET DOIT=1

 +7       ; pricing

          IF '$TEST

               IF $$DOFIELD(1.03)

                   SET DOIT=1

 +8       IF '$TEST

               SET DOIT=0

 +9        QUIT DOIT

ISCPT()   ; non-prescription, CPT code - detected by absence of RXI

 +1        QUIT $$GET^DDSVAL(DIE,.DA,1.01)=""

DOFIELD(N) ;EP - context: form, page 1, block ABSP PAGE 1 BOTTOM

 +1       ; DIE = "^ABSP(9002313.51,DA(1),2,DA,"

 +2       ; DA(1), DA point to the line item.

 +3       ; But we're looking at the yes/no's at ^ABSP(9002313.51,DA(1),*)

 +4        NEW RET

           SET RET=$$GET^DDSVAL(9002313.51,DA(1),N)

 +5       ; For insurance, you have to have had lines set up for insurance, too

 +6        IF N=1.01

               IF RET

                   SET RET=RET&$DATA(^ABSP(9002313.51,DA(1),2,DA,"I",1))

 +7       ; for pricing, this can't be POSTAGE (it's done on Page 11, not 7)

 +8        IF N=1.03

               Begin DoDot:1

 +9       ; Do not ask pricing for POSTAGE; it has its own pricing page

 +10               IF $$GET^DDSVAL(DIE,.DA,.03)="POSTAGE"

                       SET RET=0

                       QUIT

 +11      ; Do ask pricing for CPT codes (detected by absence of RXI)

 +12               IF $$ISCPT

                       SET RET=1

                       QUIT

               End DoDot:1

 +13       QUIT RET

ENAB      ; enable/disable blocks,fields based on settings in fields 1.01 ff

 +1       ; done on entry to page 7

 +2       ; insurance

           DO ENAB1(1.01,4,1)

 +3       ;

 +4       ;IHS/SD/lwj 8/30/02 NCPDP 5.1 changes

 +5       ; A new field for the prior auth type code was needed- to have

 +6       ; the screen flow, the new field, and the existing preauthorization

 +7       ; field were reversed - field 1 is now the type, and field 2 is the

 +8       ; prior auth number (formally preauthorization)

 +9       ;IHS/SD/lwj 8/30/02 now the prior auth type

           DO ENAB1(1.02,1,2)

 +10      ;

 +11      ;IHS/SD/lwj 8/30/02 this is the prior auth number

           DO ENAB1(1.02,2,2)

 +12      ;

 +13      ;IHS/OIT/SCR 11/20/08 modified line to include incentive amount

 +14      ;N F F F=11,12,14 D ENAB1(1.03,F,3) ; qty, unit price, dispense fee

 +15      ; qty, unit price, dispense fee,incentive amount

           NEW F

           FOR F=11,12,17,14

               DO ENAB1(1.03,F,3)

 +16      ; set up some pricing defaults if nothing is set up yet

 +17       IF $$DOFIELD(1.03)

               IF $$GET^DDSVAL(DIE,.DA,5.02)=""

                   DO PAGE7^ABSPOSQP

 +18      ; set up some insurance defaults if nothing is set up yet

 +19       IF $$DOFIELD(1.01)

               IF $$GET^DDSVAL(DIE,.DA,7.01)=""

                   DO INIT^ABSPOSI8

 +20       QUIT

ENAB1(ORIG,FIELD,BLOCK,PAGE) ;EP

 +1        IF '$GET(PAGE)

               SET PAGE=7

 +2        DO UNED^DDSUTL(FIELD,BLOCK,PAGE,'$$DOFIELD(ORIG))

 +3        QUIT

RECALC1   ;EP - from ABSPOSI2,ABSPOSQP

 +1       ; when you change quantity or unit price

 +2        NEW X

           SET X=$$GET^DDSVAL(DIE,.DA,5.01)

 +3        NEW Y

           SET Y=$$GET^DDSVAL(DIE,.DA,5.02)

 +4        NEW Z

           SET Z=X*Y

 +5        SET Z=$$ROUND(Z)

 +6        DO PUT^DDSVAL(DIE,.DA,5.03,$JUSTIFY(Z,0,2))

 +7       ; and then that affects the total price

           DO RECALC2

 +8        QUIT

RECALC2   ; when you change dispense fee

 +1        NEW X

           SET X=$$GET^DDSVAL(DIE,.DA,5.03)

 +2        NEW Y

           SET Y=$$GET^DDSVAL(DIE,.DA,5.04)

 +3       ;IHS/OIT/SCR 11/20/08

 +4        NEW ABSPINCT

           SET ABSPINCT=$$GET^DDSVAL(DIE,.DA,5.07)

 +5       ; N Z S Z=X+Y

 +6        NEW Z

           SET Z=X+Y+ABSPINCT

 +7        SET Z=$$ROUND(Z)

 +8        DO PUT^DDSVAL(DIE,.DA,5.05,$JUSTIFY(Z,0,2))

 +9        QUIT

ROUND(X)   QUIT X*100+.5\1/100

ABSPOSI7.m