Routine: ABSPOSQ2

ABSPOSQ2 ; IHS/FCS/DRS - form transmission packets ;  [ 11/07/2002  6:57 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**3,31,42**;JUN 01, 2001;Build 38

 ;  Status comes in as 30. Or as 31.

 ;  Status set to 40 which PACKET() is in progress.

 ;  When PACKET() is done, the status is changed to 50

 ;  The transmission packet is in ^ABSPECX("POS",DIALOUT,"C",*)

 ;  and ABSPOSQ3 is scheduled to do the transmission.

 ;  Split-off code:

 ;      STATUS31^ABSPOSQF - Insurer asleep condition is handled here

 ;      PACKET^ABSPOSQG   - packetizing RXILIST(*)

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

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

 ;  Prior Authorization claims must now be sent one by one - no

 ;  bundling allowed.  New logic added before bundling to check

 ;  the overrides for field 498.01 (Request Type), 498.02 (Request

 ;  period date-begin),  498.03 (Request period date-end), and 498.04

 ;  (basis of request).  These four fields are required for a prior

 ;  authorization claim, and if we encounter even one of the fields

 ;  we will keep the claim from bundling.

PACKETS ; construct packets for transmission to NDC

 ; your work list is ^ABSPT("AD",30)

 ; LOGGING:  Do NOT keep a "current" slot.

 ;  When you need to log something, use one of these routines:

 ;  LOG59^ABSPOSQ(MSG,IEN59) - log MSG to this one slot

 ;  LOG2LIST^ABSPOSQ(MSG) - log MSG to all on RXILIST(*)

 ;  LOG2CLM^ABSPOSQ(MSG,IEN02) - log MSG to all on this 9002313.02 claim

 N ERROR,SILENT S SILENT=1

 N RXILIST,STATUS30

 D STATUS31^ABSPOSQF ; deal with insurer alseep waiting

 F STATUS30=30 I $D(^ABSPT("AD",STATUS30)) D STATUS30

 ; If there are still any claims with status 30,

 ; perhaps due to failed LOCK59, queue up ABSPOSQ2 to run again

 N NEEDQ1 S NEEDQ1=$O(^ABSPT("AD",30,0))

 ; Don't worry about status 31 - retry after insurer asleep

 ; was already scheduled, when the response packet came.

 ;I 'NEEDQ1 S NEEDQ1=$O(^ABSPT("AD",31,0))

 I NEEDQ1 H 60 D TASK^ABSPOSQ1

SETSTAT(NEWSTAT) ;EP - ABSPOSQF ; given IEN59

 N ABSBRXI S ABSBRXI=IEN59 ; unfortunate variable naming convention

 D SETSTAT^ABSPOSU(NEWSTAT)

SETRESU(RESCODE,TEXT)   ; given IEN59

 N ABSBRXI S ABSBRXI=IEN59 ; unfortunate variable naming convention

 D SETRESU^ABSPOSU(RESCODE,TEXT)

 ; Locking and unlocking the list of claims with

 ; with STATUS30=30 or 31. The lock should always succeed.

 ; But since it's required to be a timed lock, LOCK59 is a $$,

 ; true if successful, false if failure.

LOCK59() ;EP - ABSPOSQF

 L +^ABSPT("AD",STATUS30):60 Q $T

UNLOCK59 ;EP - ABSPOSQF

 L -^ABSPT("AD",STATUS30) Q

NEXT59(X) ;EP - ABSPOSQF

 N INS,T

N59A S X=$O(^ABSPT("AD",STATUS30,X))

 I X="" Q X  ; end of list, return ""

 ; but if the insurer is asleep, don't take this one

 S INS=$P(^ABSPT(X,1),U,6)

 I $G(INS)="" Q X  ;IHS/OIT/SCR 05/12/09 patch 31 avoid undefined

 I '$D(^ABSPEI(INS)) Q X ;IHS/OIT/RAN 03/31/2011 patch 42 avoid undefined

 S T=$P($G(^ABSPEI(INS,101)),U) ; insurer asleep retry time

 I 'T Q X  ; insurer is not asleep

 ; - below here - insurer is asleep -

 ; If cancellation is requested, let it through, regardless of sleep.

 ; This will speed it on its way to cancellation

 I $G(^ABSPT(X,3)) Q X

 ; If necessary, update the .59's record of when to retry

 I $P($G(^ABSPT(X,8)),U)'=T D  ;

 . S $P(^ABSPT(X,8),U)=T ; stamp with latest retry time

 . N IEN59 S IEN59=X D SETSTAT(31) ; force screen update, too

 . D LOG59^ABSPOSQ("Insurer still asleep - retry at "_T,IEN59)

 I T<$$NOW Q X  ; time to retry, so yes, we do this one

 ;. don't clear this - a successful non-sleep response will clear it

 ;. S $P(^ABSPEI(INS,101),U)="" ; clear the sleep-until time

 ;. but don't clear the piece 5 current interval, as we may increment

 ; Else still in waiting - if it's status 30, change it to 31

 I STATUS30=30 D

 . N IEN59 S IEN59=X D SETSTAT(31)

 . S $P(^ABSPT(IEN59,8),U)=$P(^ABSPEI(INS,101),U)

 . S $P(^ABSPT(IEN59,8),U,3)=INS

 G N59A ; still in wait time; don't look at this claim

NOW() N %,%H,%I,X D NOW^%DTC Q %

STATUS30 ; given STATUS30=30

 N IEN59 S IEN59=""

 Q:'$$LOCK59

 F  S IEN59=$$NEXT59(IEN59) Q:IEN59=""  D

 . K RXILIST ; init list each time through this loop

 . S RXILIST(IEN59)=""

 . D SETSTAT(40) ; set its status to "packetizing"

 .; Reversals go in a packet alone

 . I $G(^ABSPT(IEN59,4)) G POINTX

.;

 .;IHS/SD/lwj 8/5/02  NCPDP 5.1 - claim cannot be bundled if

 .; there is prior authorization information

 .; use CHKPA when the processor are ready to use the actual

 .; prior authorization segment - for now, use the CHKPA2

 .; G:$$CHKPA() POINTX

 . G:$$CHKPA2() POINTX

.;

 .; Who is the patient?   Find all other prescriptions for this

 .; patient which have status 30, and add them to the RXILIST, too

 .; Must also have same VISIT and same DIVISION

.;

 . N RA0,RA1 S RA0=^ABSPT(IEN59,0),RA1=^(1)

 . N IEN59 S IEN59="" ; preserve the top-level index!

 . F  S IEN59=$$NEXT59(IEN59) Q:'IEN59  D

 . . N RB0,RB1 S RB0=^ABSPT(IEN59,0),RB1=^(1)

 . . ; Only bundle when you have the same:

 . . ; Patient, Visit, Division, Division Source, Insurer, Pharmacy

 . . I $P(RA0,U,6,7)'=$P(RB0,U,6,7) Q

 . . I $P(RA1,U,4,7)'=$P(RB1,U,4,7) Q

 . . I $P(RB0,U,2)'=30 Q  ; might have been canceled, or maybe 31'd

 . . I $P(RB0,U,2)'=STATUS30 D  Q

 . . . D IMPOSS^ABSPOSUE("P","TI","IEN59 status "_$P(RB0,U,2)_" but must be 30",,"STATUS30",$T(+0))

 . . D SETSTAT(40)

 . . S RXILIST(IEN59)=""

POINTX . ; (reversals branch here around multi-claim packeting)

. ;

 . ; so now we have a big list of prescriptions, RXILIST(*)

 . ; they're all marked with status = 40 PACKETIZING

 . ; Get going - packetize them!

. ;

 . S ERROR=$$PACKET^ABSPOSQG ;

. ;

 . ; Having packetized, reset status to 50, Waiting for transmit

 . ; There should never be an error returned by $$PACKET,

 . ; although it could happen.

 . ; But if there was an error, reset the status to 99 right now.

 . ; And set that status for every prescription in the RXILIST,

 . ;  even if maybe only one of them caused all the trouble.

. ;

 . S IEN59="" F  S IEN59=$O(RXILIST(IEN59)) Q:IEN59=""  D

 . . I ERROR D

 . . . D SETSTAT(99) ;

 . . . D SETRESU($P(ERROR,U),$P(ERROR,U,2,$L(ERROR,U))) ;

 . . E  D

 . . . D SETSTAT(50) ; "Waiting for transmit"

 D UNLOCK59

 ; TASK^ABSPOSQ2  starts up a sender-receiver in ABSPOSQ3.

 ; TASK is an entry point used by POKE^ABSPOS2D

 ; It may well be called from other places in the future,

 ; if we try to be clever and start the dialing while we're getting

 ; claim information together, for instance.

TASK ;EP - ABSPOS2D,ABSPOSAP,ABSPOSC3,ABSPOSQG

 N X,Y,%DT

 S X="N",%DT="ST" D ^%DT

 D TASKAT(Y)

TASKAT(ZTDTH) ;EP - ABSPOSQJ

 ;ZTDTH = time when you want COMMS^ABSPOSQ3 to run

 ; called from TASK, above, normally

 ; called here from ABSPOSQ3 when it's requeueing itself for

 ; retry after a dial-out error condition

 ;N (DUZ,DIALOUT,TIME,ZTDTH)

 N ZTRTN,ZTIO,ZTSAVE

 S ZTRTN="COMMS^ABSPOSQ3",ZTIO=""

 S ZTSAVE("DIALOUT")="" ; which entry in 9002313.55

 D ^%ZTLOAD

KSCRATCH ;EP - ABSPOSQG ; Kill scratch globals

 K ^ABSPECX($J,"R")

 K ^ABSPECX($J,"C")

CHKPA() ;---------------------------------------------------------------

 ;IHS/SD/lwj 8/30/02 NCPDP 5.1 - we aren't quite ready for this

 ; yet - the below logic is going to work with the actual

 ; prior authorization segment, and no one is going to use that

 ; or support that segment for a while.  SO.....I'm leaving this

 ; here for future reference - BUT for now, we're going to use

 ; the CHKPA2 routine to simply check for field 461 and 461.

;*

 ;IHS/SD/lwj  8/5/02  NCPDP 5.1  If any of the following fields

 ; appear as an override on this claim, we must consider it a prior

 ; authorization claim, and it cannot be bundled with other claims.

 ; 498.01 Request Type

 ; 498.02 Request Period Date Begin

 ; 498.03 Request Period Date End

 ; 498.04 Basis of Request

 N OVRREC,OVRFLD,NCPDPF,NCPDPFN,PACLM

 S PACLM=0

 S OVRREC=$P($G(^ABSPT(IEN59,1)),U,13)   ;grab the overrides

 Q:OVRREC="" 0   ;no overrides - can't be a prior auth claim

 ; loop through the overrides and look for the prior auth fields

 S OVRFLD=0

 F  S OVRFLD=$O(^ABSP(9002313.511,OVRREC,1,OVRFLD)) Q:'+OVRFLD  D

 . S NCPDPF=$P($G(^ABSP(9002313.511,OVRREC,1,OVRFLD,0)),U) ;int fld

 . S NCPDPFN=$P($G(^ABSPF(9002313.91,NCPDPF,0)),U)  ;fld number

 . Q:(NCPDPFN<498.01)!(NCPDPFN>498.04)

 . S PACLM=1

 Q PACLM

CHKPA2() ;---------------------------------------------------------------

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

 ;Until processors are ready to use the prior authorization

 ; segment, we are going to use this routine to check for

 ; a prior authorization.  To do this we will simply check

 ; for field 461 (Prior Authorization type code) and field

 ; 462 (Prior Authorization Number Submitted)

 ; If either exist, we will not bundle the claim.  Prior

 ; authorization claims must be sent on their own.

;*

 N PATYP,PANUM

 S PACLM=0

 S PATYP=$P($G(^ABSPT(IEN59,1)),U,15)    ;prior auth type code

 S PANUM=$P($G(^ABSPT(IEN59,1)),U,9)     ;prior auth number

 I ($G(PATYP)'="")!($G(PANUM)'="") S PACLM=1

 Q PACLM

ABSPOSQ2  ; IHS/FCS/DRS - form transmission packets ;  [ 11/07/2002  6:57 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**3,31,42**;JUN 01, 2001;Build 38

 +2       ;

 +3       ;  Status comes in as 30. Or as 31.

 +4       ;  Status set to 40 which PACKET() is in progress.

 +5       ;  When PACKET() is done, the status is changed to 50

 +6       ;  The transmission packet is in ^ABSPECX("POS",DIALOUT,"C",*)

 +7       ;  and ABSPOSQ3 is scheduled to do the transmission.

 +8       ;

 +9       ;  Split-off code:

 +10      ;      STATUS31^ABSPOSQF - Insurer asleep condition is handled here

 +11      ;      PACKET^ABSPOSQG   - packetizing RXILIST(*)

 +12      ;

 +13      ;----------------------------------------------------------------

 +14      ; IHS/SD/lwj 8/5/02  NCPDP 5.1 changes

 +15      ;  Prior Authorization claims must now be sent one by one - no

 +16      ;  bundling allowed.  New logic added before bundling to check

 +17      ;  the overrides for field 498.01 (Request Type), 498.02 (Request

 +18      ;  period date-begin),  498.03 (Request period date-end), and 498.04

 +19      ;  (basis of request).  These four fields are required for a prior

 +20      ;  authorization claim, and if we encounter even one of the fields

 +21      ;  we will keep the claim from bundling.

 +22      ;

 +23      ;

PACKETS   ; construct packets for transmission to NDC

 +1       ; your work list is ^ABSPT("AD",30)

 +2       ;

 +3       ; LOGGING:  Do NOT keep a "current" slot.

 +4       ;  When you need to log something, use one of these routines:

 +5       ;  LOG59^ABSPOSQ(MSG,IEN59) - log MSG to this one slot

 +6       ;  LOG2LIST^ABSPOSQ(MSG) - log MSG to all on RXILIST(*)

 +7       ;  LOG2CLM^ABSPOSQ(MSG,IEN02) - log MSG to all on this 9002313.02 claim

 +8       ;

 +9        NEW ERROR,SILENT

           SET SILENT=1

 +10       NEW RXILIST,STATUS30

 +11      ; deal with insurer alseep waiting

           DO STATUS31^ABSPOSQF

 +12       FOR STATUS30=30

               IF $DATA(^ABSPT("AD",STATUS30))

                   DO STATUS30

 +13      ; If there are still any claims with status 30,

 +14      ; perhaps due to failed LOCK59, queue up ABSPOSQ2 to run again

 +15       NEW NEEDQ1

           SET NEEDQ1=$ORDER(^ABSPT("AD",30,0))

 +16      ; Don't worry about status 31 - retry after insurer asleep

 +17      ; was already scheduled, when the response packet came.

 +18      ;I 'NEEDQ1 S NEEDQ1=$O(^ABSPT("AD",31,0))

 +19       IF NEEDQ1

               HANG 60

               DO TASK^ABSPOSQ1

 +20       QUIT

SETSTAT(NEWSTAT) ;EP - ABSPOSQF ; given IEN59

 +1       ; unfortunate variable naming convention

           NEW ABSBRXI

           SET ABSBRXI=IEN59

 +2        DO SETSTAT^ABSPOSU(NEWSTAT)

 +3        QUIT

SETRESU(RESCODE,TEXT) ; given IEN59

 +1       ; unfortunate variable naming convention

           NEW ABSBRXI

           SET ABSBRXI=IEN59

 +2        DO SETRESU^ABSPOSU(RESCODE,TEXT)

 +3        QUIT

 +4       ; Locking and unlocking the list of claims with

 +5       ; with STATUS30=30 or 31. The lock should always succeed.

 +6       ; But since it's required to be a timed lock, LOCK59 is a $$,

 +7       ; true if successful, false if failure.

LOCK59()  ;EP - ABSPOSQF

 +1        LOCK +^ABSPT("AD",STATUS30):60

           QUIT $TEST

UNLOCK59  ;EP - ABSPOSQF

 +1        LOCK -^ABSPT("AD",STATUS30)

           QUIT

NEXT59(X) ;EP - ABSPOSQF

 +1        NEW INS,T

N59A       SET X=$ORDER(^ABSPT("AD",STATUS30,X))

 +1       ; end of list, return ""

           IF X=""

               QUIT X

 +2       ; but if the insurer is asleep, don't take this one

 +3        SET INS=$PIECE(^ABSPT(X,1),U,6)

 +4       ;IHS/OIT/SCR 05/12/09 patch 31 avoid undefined

           IF $GET(INS)=""

               QUIT X

 +5       ;IHS/OIT/RAN 03/31/2011 patch 42 avoid undefined

           IF '$DATA(^ABSPEI(INS))

               QUIT X

 +6       ; insurer asleep retry time

           SET T=$PIECE($GET(^ABSPEI(INS,101)),U)

 +7       ; insurer is not asleep

           IF 'T

               QUIT X

 +8       ; - below here - insurer is asleep -

 +9       ; If cancellation is requested, let it through, regardless of sleep.

 +10      ; This will speed it on its way to cancellation

 +11       IF $GET(^ABSPT(X,3))

               QUIT X

 +12      ; If necessary, update the .59's record of when to retry

 +13      ;

           IF $PIECE($GET(^ABSPT(X,8)),U)'=T

               Begin DoDot:1

 +14      ; stamp with latest retry time

                   SET $PIECE(^ABSPT(X,8),U)=T

 +15      ; force screen update, too

                   NEW IEN59

                   SET IEN59=X

                   DO SETSTAT(31)

 +16               DO LOG59^ABSPOSQ("Insurer still asleep - retry at "_T,IEN59)

               End DoDot:1

 +17      ; time to retry, so yes, we do this one

           IF T<$$NOW

               QUIT X

 +18      ;. don't clear this - a successful non-sleep response will clear it

 +19      ;. S $P(^ABSPEI(INS,101),U)="" ; clear the sleep-until time

 +20      ;. but don't clear the piece 5 current interval, as we may increment

 +21      ; Else still in waiting - if it's status 30, change it to 31

 +22       IF STATUS30=30

               Begin DoDot:1

 +23               NEW IEN59

                   SET IEN59=X

                   DO SETSTAT(31)

 +24               SET $PIECE(^ABSPT(IEN59,8),U)=$PIECE(^ABSPEI(INS,101),U)

 +25               SET $PIECE(^ABSPT(IEN59,8),U,3)=INS

               End DoDot:1

 +26      ; still in wait time; don't look at this claim

           GOTO N59A

NOW()      NEW %,%H,%I,X

           DO NOW^%DTC

           QUIT %

STATUS30  ; given STATUS30=30

 +1        NEW IEN59

           SET IEN59=""

 +2        IF '$$LOCK59

               QUIT

 +3        FOR

               SET IEN59=$$NEXT59(IEN59)

               IF IEN59=""

                   QUIT

               Begin DoDot:1

 +4       ; init list each time through this loop

                   KILL RXILIST

 +5                SET RXILIST(IEN59)=""

 +6       ; set its status to "packetizing"

                   DO SETSTAT(40)

 +7       ; Reversals go in a packet alone

 +8                IF $GET(^ABSPT(IEN59,4))

                       GOTO POINTX

 +9       ;

 +10      ;IHS/SD/lwj 8/5/02  NCPDP 5.1 - claim cannot be bundled if

 +11      ; there is prior authorization information

 +12      ; use CHKPA when the processor are ready to use the actual

 +13      ; prior authorization segment - for now, use the CHKPA2

 +14      ; G:$$CHKPA() POINTX

 +15               IF $$CHKPA2()

                       GOTO POINTX

 +16      ;

 +17      ; Who is the patient?   Find all other prescriptions for this

 +18      ; patient which have status 30, and add them to the RXILIST, too

 +19      ; Must also have same VISIT and same DIVISION

 +20      ;

 +21               NEW RA0,RA1

                   SET RA0=^ABSPT(IEN59,0)

                   SET RA1=^(1)

 +22      ; preserve the top-level index!

                   NEW IEN59

                   SET IEN59=""

 +23               FOR

                       SET IEN59=$$NEXT59(IEN59)

                       IF 'IEN59

                           QUIT

                       Begin DoDot:2

 +24                       NEW RB0,RB1

                           SET RB0=^ABSPT(IEN59,0)

                           SET RB1=^(1)

 +25      ; Only bundle when you have the same:

 +26      ; Patient, Visit, Division, Division Source, Insurer, Pharmacy

 +27                       IF $PIECE(RA0,U,6,7)'=$PIECE(RB0,U,6,7)

                               QUIT

 +28                       IF $PIECE(RA1,U,4,7)'=$PIECE(RB1,U,4,7)

                               QUIT

 +29      ; might have been canceled, or maybe 31'd

                           IF $PIECE(RB0,U,2)'=30

                               QUIT

 +30                       IF $PIECE(RB0,U,2)'=STATUS30

                               Begin DoDot:3

 +31                               DO IMPOSS^ABSPOSUE("P","TI","IEN59 status "_$PIECE(RB0,U,2)_" but must be 30",,"STATUS30",$TEXT(+0))

                               End DoDot:3

                               QUIT

 +32                       DO SETSTAT(40)

 +33                       SET RXILIST(IEN59)=""

                       End DoDot:2

POINTX    ; (reversals branch here around multi-claim packeting)

 +1       ;

 +2       ; so now we have a big list of prescriptions, RXILIST(*)

 +3       ; they're all marked with status = 40 PACKETIZING

 +4       ; Get going - packetize them!

 +5       ;

 +6       ;

                   SET ERROR=$$PACKET^ABSPOSQG

 +7       ;

 +8       ; Having packetized, reset status to 50, Waiting for transmit

 +9       ; There should never be an error returned by $$PACKET,

 +10      ; although it could happen.

 +11      ; But if there was an error, reset the status to 99 right now.

 +12      ; And set that status for every prescription in the RXILIST,

 +13      ;  even if maybe only one of them caused all the trouble.

 +14      ;

 +15               SET IEN59=""

FOR

                       SET IEN59=$ORDER(RXILIST(IEN59))

                       IF IEN59=""

                           QUIT

                       Begin DoDot:2

 +16                       IF ERROR

                               Begin DoDot:3

 +17      ;

                                   DO SETSTAT(99)

 +18      ;

                                   DO SETRESU($PIECE(ERROR,U),$PIECE(ERROR,U,2,$LENGTH(ERROR,U)))

                               End DoDot:3

 +19                      IF '$TEST

                               Begin DoDot:3

 +20      ; "Waiting for transmit"

                                   DO SETSTAT(50)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       DO UNLOCK59

 +22       QUIT

 +23      ;

 +24      ; TASK^ABSPOSQ2  starts up a sender-receiver in ABSPOSQ3.

 +25      ; TASK is an entry point used by POKE^ABSPOS2D

 +26      ; It may well be called from other places in the future,

 +27      ; if we try to be clever and start the dialing while we're getting

 +28      ; claim information together, for instance.

 +29      ;

TASK      ;EP - ABSPOS2D,ABSPOSAP,ABSPOSC3,ABSPOSQG

 +1        NEW X,Y,%DT

 +2        SET X="N"

           SET %DT="ST"

           DO ^%DT

 +3        DO TASKAT(Y)

 +4        QUIT

TASKAT(ZTDTH) ;EP - ABSPOSQJ

 +1       ;ZTDTH = time when you want COMMS^ABSPOSQ3 to run

 +2       ; called from TASK, above, normally

 +3       ; called here from ABSPOSQ3 when it's requeueing itself for

 +4       ; retry after a dial-out error condition

 +5       ;N (DUZ,DIALOUT,TIME,ZTDTH)

 +6        NEW ZTRTN,ZTIO,ZTSAVE

 +7        SET ZTRTN="COMMS^ABSPOSQ3"

           SET ZTIO=""

 +8       ; which entry in 9002313.55

           SET ZTSAVE("DIALOUT")=""

 +9        DO ^%ZTLOAD

 +10       QUIT

KSCRATCH  ;EP - ABSPOSQG ; Kill scratch globals

 +1        KILL ^ABSPECX($JOB,"R")

 +2        KILL ^ABSPECX($JOB,"C")

 +3        QUIT

 +4       ;

CHKPA()   ;---------------------------------------------------------------

 +1       ;IHS/SD/lwj 8/30/02 NCPDP 5.1 - we aren't quite ready for this

 +2       ; yet - the below logic is going to work with the actual

 +3       ; prior authorization segment, and no one is going to use that

 +4       ; or support that segment for a while.  SO.....I'm leaving this

 +5       ; here for future reference - BUT for now, we're going to use

 +6       ; the CHKPA2 routine to simply check for field 461 and 461.

 +7       ;*

 +8       ;IHS/SD/lwj  8/5/02  NCPDP 5.1  If any of the following fields

 +9       ; appear as an override on this claim, we must consider it a prior

 +10      ; authorization claim, and it cannot be bundled with other claims.

 +11      ; 498.01 Request Type

 +12      ; 498.02 Request Period Date Begin

 +13      ; 498.03 Request Period Date End

 +14      ; 498.04 Basis of Request

 +15      ;

 +16       NEW OVRREC,OVRFLD,NCPDPF,NCPDPFN,PACLM

 +17       SET PACLM=0

 +18      ;

 +19      ;grab the overrides

           SET OVRREC=$PIECE($GET(^ABSPT(IEN59,1)),U,13)

 +20      ;no overrides - can't be a prior auth claim

           IF OVRREC=""

               QUIT 0

 +21      ;

 +22      ; loop through the overrides and look for the prior auth fields

 +23       SET OVRFLD=0

 +24       FOR

               SET OVRFLD=$ORDER(^ABSP(9002313.511,OVRREC,1,OVRFLD))

               IF '+OVRFLD

                   QUIT

               Begin DoDot:1

 +25      ;int fld

                   SET NCPDPF=$PIECE($GET(^ABSP(9002313.511,OVRREC,1,OVRFLD,0)),U)

 +26      ;fld number

                   SET NCPDPFN=$PIECE($GET(^ABSPF(9002313.91,NCPDPF,0)),U)

 +27               IF (NCPDPFN<498.01)!(NCPDPFN>498.04)

                       QUIT

 +28               SET PACLM=1

               End DoDot:1

 +29      ;

 +30       QUIT PACLM

 +31      ;

CHKPA2()  ;---------------------------------------------------------------

 +1       ; IHS/SD/lwj  8/30/02  NCPDP 5.1

 +2       ;Until processors are ready to use the prior authorization

 +3       ; segment, we are going to use this routine to check for

 +4       ; a prior authorization.  To do this we will simply check

 +5       ; for field 461 (Prior Authorization type code) and field

 +6       ; 462 (Prior Authorization Number Submitted)

 +7       ; If either exist, we will not bundle the claim.  Prior

 +8       ; authorization claims must be sent on their own.

 +9       ;*

 +10      ;

 +11       NEW PATYP,PANUM

 +12       SET PACLM=0

 +13      ;

 +14      ;prior auth type code

           SET PATYP=$PIECE($GET(^ABSPT(IEN59,1)),U,15)

 +15      ;prior auth number

           SET PANUM=$PIECE($GET(^ABSPT(IEN59,1)),U,9)

 +16       IF ($GET(PATYP)'="")!($GET(PANUM)'="")

               SET PACLM=1

 +17      ;

 +18       QUIT PACLM

ABSPOSQ2.m