ABSPOSIO.m

ABSPOSIO ; IHS/FCS/DRS - NCPDP Overrides form ;   [ 06/03/2002  4:40 AM ]

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

 ; Property of Indian Health Service

 ;

 ; IHS/OKCAO/POS  IHS/ASDST/lwj  1/9/02  added logic for overrides

 ; For the "new" claim option, the adding and updating of 

 ; override codes was not functioning properly - Patrick wrote

 ; code to first look up existing overrides for the prescription

 ; and/or add new overrides when requested.

 ; The original call from ABSPOSIB (at tag THEASKS) was altered

 ; to call into NEWENTR2 instead of to NEWENTRY.

 Q

NEWENTRY ;EP - create new entry if needed

 I '$$GET^DDSVAL(DIE,.DA,1.09) D

 . ;W "Creating a new entry for Overrides",! R ">> ",%,!

 . D PUT^DDSVAL(DIE,.DA,1.09,$$NEW^ABSPOSO2,,"I")

 ;W "Field 1.09 = ",$$GET^DDSVAL(DIE,.DA,1.09,,"I"),!

 ;N % R ">>",%,!

 Q

NEWENTR1()         ;EP  ;from a function call IHS/OKCAO/POS 1/9/02 overrides

 ; No routines are calling into this point at this time.

 ;

 ;

NEWENTR2 ;EP - IHS/OKCAO/POS  IHS/ASDST/lwj 1/9/02  updating of overrides

 ; The original logic for the maintaining of the override codes

 ; in the "new" claim feature was not correct - this routine

 ; will replace that logic.

 ;

 ; Called from ABSPOSIB

 ;  If there isn't an RX - routine will simply quit

 ;  If there is a RX, and it already has overrides, the overrides

 ;   will be retrieved for updating

 ;  If there is a RX, and it doesn't have overrides, a new override

 ;   will be created to store with the transaction

 ;

 N RXI,RXR,OVERRIDE,FFDA,STRING,ZERR  ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE

 ;

 ; get the prescription information

 S RXI=$$GET^DDSVAL(DIE,.DA,1.01)    ;RX IEN

 S RXR=$$GET^DDSVAL(DIE,.DA,1.02)    ;RX Refill IEN

 I 'RXI D NEWENTRY Q:$Q OVERRIDE Q

 ;

 ; figure out if prescription already has override information

 S OVERRIDE=$$GETIEN^ABSPOSO(RXI,RXR)   ;get override number

 ;

 ; if overrides exist - put on screen for updating

 I $G(OVERRIDE) D         ;override exists

 . S STRING(1)="Will add override from IEN RX  "_RXI  ;msg on scrn

 . S:+RXR STRING(1)=STRING(1)_"   IEN Refill  "_RXR

 . D HLP^DDSUTL(.STRING)      ;displays what is happening

 ;

 ; if override doesn't exist - create new code for use in trans file

 I '$G(OVERRIDE) D

 . S OVERRIDE=$$NEW^ABSPOSO2    ;get new code

 . S STRING(1)="Will add new Override  "_OVERRIDE

 . D HLP^DDSUTL(.STRING)

 . ;

 . I '+$G(RXR) D     ;if not a refill

 . . S FFDA(52,RXI_",",9999999.12)=OVERRIDE

 . . D FILE^DIE("","FFDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.

 . . I $D(ZERR) D LOG^ABSPOSL2("NEWENTR2+37^ABSPICNV",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.

 . ;

 . I +$G(RXR) D     ;refill

 . . S FFDA(52.1,RXR_","_RXI_",",9999999.12)=OVERRIDE

 . . D FILE^DIE("","FFDA","ZERR") ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.

 . . I $D(ZERR) D LOG^ABSPOSL2("NEWENTR2+42^ABSPICNV",.ZERR) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.

 ;

 ; now- update the input data file with the override code

 D PUT^DDSVAL(DIE,.DA,1.09,OVERRIDE,,"I")

 ;

 Q:$Q OVERRIDE Q

ABSPOSIO  ; IHS/FCS/DRS - NCPDP Overrides form ;   [ 06/03/2002  4:40 AM ]

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

 +2       ; Property of Indian Health Service

 +3       ;

 +4       ; IHS/OKCAO/POS  IHS/ASDST/lwj  1/9/02  added logic for overrides

 +5       ; For the "new" claim option, the adding and updating of 

 +6       ; override codes was not functioning properly - Patrick wrote

 +7       ; code to first look up existing overrides for the prescription

 +8       ; and/or add new overrides when requested.

 +9       ; The original call from ABSPOSIB (at tag THEASKS) was altered

 +10      ; to call into NEWENTR2 instead of to NEWENTRY.

 +11       QUIT 

NEWENTRY  ;EP - create new entry if needed

 +1        IF '$$GET^DDSVAL(DIE,.DA,1.09)

               Begin DoDot:1

 +2       ;W "Creating a new entry for Overrides",! R ">> ",%,!

 +3                DO PUT^DDSVAL(DIE,.DA,1.09,$$NEW^ABSPOSO2,,"I")

               End DoDot:1

 +4       ;W "Field 1.09 = ",$$GET^DDSVAL(DIE,.DA,1.09,,"I"),!

 +5       ;N % R ">>",%,!

 +6        QUIT 

NEWENTR1() ;EP  ;from a function call IHS/OKCAO/POS 1/9/02 overrides

 +1       ; No routines are calling into this point at this time.

 +2       ;

 +3       ;

NEWENTR2  ;EP - IHS/OKCAO/POS  IHS/ASDST/lwj 1/9/02  updating of overrides

 +1       ; The original logic for the maintaining of the override codes

 +2       ; in the "new" claim feature was not correct - this routine

 +3       ; will replace that logic.

 +4       ;

 +5       ; Called from ABSPOSIB

 +6       ;  If there isn't an RX - routine will simply quit

 +7       ;  If there is a RX, and it already has overrides, the overrides

 +8       ;   will be retrieved for updating

 +9       ;  If there is a RX, and it doesn't have overrides, a new override

 +10      ;   will be created to store with the transaction

 +11      ;

 +12      ; /IHS/OIT/RAM ; 12 JUN 17 ; ADD DBS CALL ERROR RETURN VARIABLE

           NEW RXI,RXR,OVERRIDE,FFDA,STRING,ZERR

 +13      ;

 +14      ; get the prescription information

 +15      ;RX IEN

           SET RXI=$$GET^DDSVAL(DIE,.DA,1.01)

 +16      ;RX Refill IEN

           SET RXR=$$GET^DDSVAL(DIE,.DA,1.02)

 +17       IF 'RXI

               DO NEWENTRY

               IF $QUIT

                   QUIT OVERRIDE

               QUIT 

 +18      ;

 +19      ; figure out if prescription already has override information

 +20      ;get override number

           SET OVERRIDE=$$GETIEN^ABSPOSO(RXI,RXR)

 +21      ;

 +22      ; if overrides exist - put on screen for updating

 +23      ;override exists

           IF $GET(OVERRIDE)

               Begin DoDot:1

 +24      ;msg on scrn

                   SET STRING(1)="Will add override from IEN RX  "_RXI

 +25               IF +RXR

                       SET STRING(1)=STRING(1)_"   IEN Refill  "_RXR

 +26      ;displays what is happening

                   DO HLP^DDSUTL(.STRING)

               End DoDot:1

 +27      ;

 +28      ; if override doesn't exist - create new code for use in trans file

 +29       IF '$GET(OVERRIDE)

               Begin DoDot:1

 +30      ;get new code

                   SET OVERRIDE=$$NEW^ABSPOSO2

 +31               SET STRING(1)="Will add new Override  "_OVERRIDE

 +32               DO HLP^DDSUTL(.STRING)

 +33      ;

 +34      ;if not a refill

                   IF '+$GET(RXR)

                       Begin DoDot:2

 +35                       SET FFDA(52,RXI_",",9999999.12)=OVERRIDE

 +36      ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.

                           DO FILE^DIE("","FFDA","ZERR")

 +37      ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.

                           IF $DATA(ZERR)

                               DO LOG^ABSPOSL2("NEWENTR2+37^ABSPICNV",.ZERR)

                       End DoDot:2

 +38      ;

 +39      ;refill

                   IF +$GET(RXR)

                       Begin DoDot:2

 +40                       SET FFDA(52.1,RXR_","_RXI_",",9999999.12)=OVERRIDE

 +41      ; /IHS/OIT/RAM ; 12 JUN 17 ; UPDATE DBS CALL TO ALLOW FOR ERROR RETURN.

                           DO FILE^DIE("","FFDA","ZERR")

 +42      ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.

                           IF $DATA(ZERR)

                               DO LOG^ABSPOSL2("NEWENTR2+42^ABSPICNV",.ZERR)

                       End DoDot:2

               End DoDot:1

 +43      ;

 +44      ; now- update the input data file with the override code

 +45       DO PUT^DDSVAL(DIE,.DA,1.09,OVERRIDE,,"I")

 +46      ;

 +47       IF $QUIT

               QUIT OVERRIDE

           QUIT