Routine: ABSPOSU

ABSPOSU ; IHS/FCS/DRS - utilities ;

 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001

 ; some common utilities called a lot.

 ; SETSTAT - set status field for ^ABSPT(ABSBRXI,

SETSTAT(STATUS) ;EP - from many places

 ; set ^ABSPT( status for ABSBRXI

 ; Timing problem:  if response got processed before the SETCSTAT

 ; was sent for "waiting to process response",  don't reset it now.

 I STATUS=80,$P(^ABSPT(ABSBRXI,0),U,2)>80 Q

 ; Perhaps other such detection would be a good idea here.

 ; LOCK the file - something is very wrong if you can't get the lock

 F  L +^ABSPT:300 Q:$T  Q:'$$IMPOSS^ABSPOSUE("L","RTI","LOCK +^ABSPT",,"SETSTAT",$T(+0))

 N DIE,DA,DR,X S DIE=9002313.59,DA=ABSBRXI,DR="1///"_STATUS_";7///NOW"

 I STATUS=0 S DR=DR_";15///NOW" ; START TIME, too.

 ;I STATUS=0 W "Before: ",$G(^ABSPT(ABSBRXI,0)),!

 D ^DIE

 ;I STATUS=0 W "After: ",$G(^ABSPT(ABSBRXI,0)),!

 ; Extra: make sure it's not in any index with any other status.

 ; We got one such corrupted index once and got infinite loop

 ; in a background job - it was a terrifying day.

 ; This consumes machine time but saves huge queue corruption headache.

 N X S X="" F  S X=$O(^ABSPT("AD",X)) Q:X=""  D

 .I X'=STATUS K ^ABSPT("AD",X,ABSBRXI)

 I STATUS=99 D STATUS99

 L -^ABSPT

STATUS99 ; special activity when a claim reaches status 99

 ; Transaction log in .57  (but not if it's a canceled transaction!)

 I $P($G(^ABSPT(ABSBRXI,3)),U,2) D

 .  ; canceled - shouldn't we restore old .57 into this .59?

 . D LOG^ABSPOSL($T(+0)_" - Cancellation succeeded.")

 E  D

 . N ABSP57 S ABSP57=$$NEW57(ABSBRXI)

 . D TRANSACT^ABSPOSBC(ABSP57) ; hand it to posting

 . D RECEIPT(ABSP57) ; automatic receipt printing

 ; Possible reverse-then-resubmit

 I $P(^ABSPT(ABSBRXI,1),U,12)=1 D

 . N OLDSLOT,SLOT S OLDSLOT=$$GETSLOT^ABSPOSL

 . S SLOT=ABSBRXI D SETSLOT^ABSPOSL(SLOT)

 . D LOG^ABSPOSL($T(+0)_" Reverse then Resubmit attempt:")

 . ; reverse, then resubmit

 . N X S X=$$CATEG^ABSPOSUC(ABSBRXI)

 . ; it must be a successful reversal

 . I X'="E REVERSAL ACCEPTED",X'="PAPER REVERSAL" D

 . . D LOG^ABSPOSL($T(+0)_" Cannot - reversal failed - "_X)

 . E  D

 . . S $P(^ABSPT(ABSBRXI,1),U,12)=0 ; clear the flag

 . . D LOG^ABSPOSL($T(+0)_" Now resubmit")

 . . D RESUB1^ABSPOS6D(ABSBRXI) ; resubmit it

 . . D TASK^ABSPOSIZ ; and start background processing

 . D RELSLOT^ABSPOSL

 . I OLDSLOT D SETSLOT^ABSPOSL(OLDSLOT)

 ; And at random times, winnow the log files

 I $R(10000)=0 D

 . N ZTRTN,ZTIO,ZTSAVE,ZTDTH

 . ; I $R(10)=0 winnow everything? INCOMPLETE - future

 . S ZTRTN="SILENT^ABSPOSK(1)"

 . S ZTIO="",ZTDTH=$$TADD^ABSPOSUD(DT,1)_".0222" ; tomorrow early a.m.

 . D ^%ZTLOAD

NEW57(RXI) ;EP - copy this ^ABSPT(RXI) into ^ABSPTL(N)

 F  L +^ABSPTL:300 Q:$T  Q:'$$IMPOSS^ABSPOSUE("L","RTI","LOCK ^ABSPTL",,"NEW57",$T(+0))

NEW57A N N S N=$P(^ABSPTL(0),U,3)+1

 N C S C=$P(^ABSPTL(0),U,4)+1

 S $P(^ABSPTL(0),U,3,4)=N_U_C

 I $D(^ABSPTL(N)) G NEW57A ; should never happen

 L -^ABSPTL

 M ^ABSPTL(N)=^ABSPT(RXI)

 ; Indexing - First, fileman indexing

 . N DIK,DA S DIK="^ABSPTL(",DA=N N N D IX1^DIK

 ; The NON-FILEMAN index on RXI,RXR

 . N INDEX,A,B,TYPE S TYPE=$E(RXI,$L(RXI))

 . I TYPE=1!(TYPE=2) D

 . . S A=$P(^ABSPTL(N,1),U,11)

 . . S B=$P(^ABSPTL(N,1),U)

 . . S INDEX=$S(TYPE=1:"RXIRXR",TYPE=2:"POSTAGE")

 . E  I TYPE=3 D

 . . S A=$P(^ABSPTL(N,0),U,7)

 . . S B=$P(^ABSPTL(N,1),U,3) ; VCPT

 . . S B=$P(^ABSVCPT(9002301,B,0),U) ; CPT IEN

 . . S INDEX="OTHERS"

 . E  D IMPOSS^ABSPOSUE("DB,P","TI","Bad TYPE="_TYPE,"in RXI="_RXI,"NEW57",$T(+0))

 . S ^ABSPTL("NON-FILEMAN",INDEX,A,B,N)=""

Q N

 ; $$PREV57(point to 57) returns pointer to previous transaction

 ; for the same RXI,RXR - returns "" if no such

PREV57(N57) ; EP -

 N RXI,RXR S RXI=$P(^ABSPTL(N57,1),U,11)

 S RXR=$P(^ABSPTL(N57,1),U)

 I RXI=""!(RXR="") Q ""

 Q $O(^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,N57),-1)

 ; SETCSTAT - set the status for every prescription associated with

 ; this claim

SETCSTAT(CLAIM,STATUS)       ;EP - ABSPOSAM

 N ABSBRXI

 I $$ISREVERS(CLAIM) D  Q  ; different for reversals

 .S ABSBRXI=$$RXI4REV(CLAIM) I ABSBRXI D SETSTAT(STATUS)

 S ABSBRXI=""

 F  S ABSBRXI=$O(^ABSPT("AE",CLAIM,ABSBRXI)) Q:ABSBRXI=""  D

 .D SETSTAT(STATUS)

ISREVERS(CLAIM) ;EP - ABSPOSP2

 ; is this a reversal claim?  $$ returns 1 or 0

 Q $P($G(^ABSPC(CLAIM,100)),"^",3)=11

RXI4REV(REVCLAIM)  ; given IEN of reversal claim $$this to get RXI

 ; The reversal claim must be associated with exactly one RXI.

 N RET,MBN ; MBN=Must Be Null

 S RET=$O(^ABSPT("AER",REVCLAIM,0)),MBN=$O(^(RET))

 ; Uncomment the next line when doing certification tests! (ABSPOSC*)

 ;Q RET

 I 'RET D IMPOSS^ABSPOSUE("DB,P","TI","REVCLAIM="_REVCLAIM_" and ""AER"" index",,"RXI4REV",$T(+0)) ; may not apply to certification testing!! SEE ABOVE.

 I MBN'="" D IMPOSS^ABSPOSUE("DB,P","TI","REVCLAIM="_REVCLAIM_" points back to multiple .59 entries",,"RXI4REV",$T(+0))

 Q RET

 ; SETCOMMS - for each prescription associated with this claim,

 ; point back to the log of the comms session wherein xmit/rcv happened

SETCOMMS(CLAIM,POINTER) ;EP - ABSPOSAM

 N ABSBRXI S ABSBRXI=""

 F  S ABSBRXI=$O(^ABSPT("AE",CLAIM,ABSBRXI)) Q:ABSBRXI=""  D

 .S $P(^ABSPT(ABSBRXI,0),"^",12)=POINTER

 ; SETRESU - Set Result  into ^ABSPT(ABSBRXI,2)

 ;    NOTE !!! NOTE !!! NOTE !!!  ABSBRXI must be set (not RXI) !!!

SETRESU(RESULT,TEXT)    ;EP - from many places

 S $P(^ABSPT(ABSBRXI,2),U)=RESULT

 I $G(TEXT)]"" D

 .N X,Y S X=^ABSPT(ABSBRXI,2)

 .S Y=$P(X,U),X=$P(X,U,2,$L(X,U))

 .I X="" S X=$E(TEXT,1,255-$L(Y)-1)

 .E  S X=$E(TEXT_X,1,255-$L(Y)-1)

 .S ^ABSPT(ABSBRXI,2)=Y_U_X

 I RESULT=0 Q  ; look at the associated RESPONSE in ^ABSPR(

 ; For other RESULT codes, put a textual explanation in

 ; SETCRESU - set the result code for every prescription assoc'd with

 ; this claim

SETCRESU(CLAIM,RESULT,TEXT) ;

 N ABSBRXI S ABSBRXI=""

 F  S ABSBRXI=$O(^ABSPT("AE",CLAIM,ABSBRXI)) Q:ABSBRXI=""  D

 .D SETRESU(RESULT,$G(TEXT))

 ; STATI(X) gives a text version of what status code X means.

STATI(X) ;EP - from many places ; perhaps should be a Fileman file

 I X=99 Q "Done"

 I X=50 Q "Waiting for transmit"

 I X=30 Q "Waiting for packet build"

 I X=0 Q "Waiting to start"

 I X=10 Q "Gathering claim info"

 I X=40 Q "Packet being built"

 I X=60 Q "Transmitting"

 I X=70 Q "Receiving response"

 I X=80 Q "Waiting to process response"

 I X=90 Q "Processing response"

 I X=51 Q "Wait for retry (comms error)"

 I X=31 Q "Wait for retry (insurer asleep)"

 I X=19 Q "Special grouping"

 ; When you add new X=, account for these in FETSTAT^ABSPOS2

 Q "?"_X_"?"

 ; RESULTI(X) gives a text version of what result code X means

RESULTI(X)         ;

 I X=0 Q "See detail in ABSP RESPONSES file" ; say more

 Q "Result code "_X ; a catch-all default

RECEIPT(IEN57) ; This is where the receipt would go - taskman it to print in

 ; background, somewhere, somehow

 Q:'$$DORECEI

 ; Lookup printer for this pharmacy.

 ; If none, lookup printer for this system, in general.

 ; Also customizable:  routine for each pharmacy, each system.

 ; Otherwise, a default-default routine for general receipt.

 ;S ZTIO=$P($G(^%ZIS(1,X,0)),U) Q:ZTIO=""

 ;S X="N",%DT="ST" D ^%DT S ZTDTH=Y

 ;S ZTRTN=""

 ;S ZTSAVE("ClaimIEN")=""

 ;D ^%ZTLOAD Q

DORECEI() ; Should we print a receipt?

 ; Site-specific conditions needed.

 ; example:  electronic claims only;

 ;   only claims with co-pay;

 ;   etc.

Q 0

ABSPOSU   ; IHS/FCS/DRS - utilities ;

 +1       ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001

 +2        QUIT

 +3       ; some common utilities called a lot.

 +4       ;

 +5       ; SETSTAT - set status field for ^ABSPT(ABSBRXI,

 +6       ;

SETSTAT(STATUS) ;EP - from many places

 +1       ; set ^ABSPT( status for ABSBRXI

 +2       ;

 +3       ; Timing problem:  if response got processed before the SETCSTAT

 +4       ; was sent for "waiting to process response",  don't reset it now.

 +5        IF STATUS=80

               IF $PIECE(^ABSPT(ABSBRXI,0),U,2)>80

                   QUIT

 +6       ;

 +7       ; Perhaps other such detection would be a good idea here.

 +8       ;

 +9       ; LOCK the file - something is very wrong if you can't get the lock

 +10       FOR

               LOCK +^ABSPT:300

               IF $TEST

                   QUIT

               IF '$$IMPOSS^ABSPOSUE("L","RTI","LOCK +^ABSPT",,"SETSTAT",$TEXT(+0))

                   QUIT

 +11       NEW DIE,DA,DR,X

           SET DIE=9002313.59

           SET DA=ABSBRXI

           SET DR="1///"_STATUS_";7///NOW"

 +12      ; START TIME, too.

           IF STATUS=0

               SET DR=DR_";15///NOW"

 +13      ;I STATUS=0 W "Before: ",$G(^ABSPT(ABSBRXI,0)),!

 +14       DO ^DIE

 +15      ;I STATUS=0 W "After: ",$G(^ABSPT(ABSBRXI,0)),!

 +16      ; Extra: make sure it's not in any index with any other status.

 +17      ; We got one such corrupted index once and got infinite loop

 +18      ; in a background job - it was a terrifying day.

 +19      ; This consumes machine time but saves huge queue corruption headache.

 +20       NEW X

           SET X=""

FOR

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

               IF X=""

                   QUIT

               Begin DoDot:1

 +21               IF X'=STATUS

                       KILL ^ABSPT("AD",X,ABSBRXI)

               End DoDot:1

 +22       IF STATUS=99

               DO STATUS99

 +23       LOCK -^ABSPT

 +24       QUIT

STATUS99  ; special activity when a claim reaches status 99

 +1       ; Transaction log in .57  (but not if it's a canceled transaction!)

 +2        IF $PIECE($GET(^ABSPT(ABSBRXI,3)),U,2)

               Begin DoDot:1

 +3       ; canceled - shouldn't we restore old .57 into this .59?

 +4                DO LOG^ABSPOSL($TEXT(+0)_" - Cancellation succeeded.")

               End DoDot:1

 +5       IF '$TEST

               Begin DoDot:1

 +6                NEW ABSP57

                   SET ABSP57=$$NEW57(ABSBRXI)

 +7       ; hand it to posting

                   DO TRANSACT^ABSPOSBC(ABSP57)

 +8       ; automatic receipt printing

                   DO RECEIPT(ABSP57)

               End DoDot:1

 +9       ; Possible reverse-then-resubmit

 +10       IF $PIECE(^ABSPT(ABSBRXI,1),U,12)=1

               Begin DoDot:1

 +11               NEW OLDSLOT,SLOT

                   SET OLDSLOT=$$GETSLOT^ABSPOSL

 +12               SET SLOT=ABSBRXI

                   DO SETSLOT^ABSPOSL(SLOT)

 +13               DO LOG^ABSPOSL($TEXT(+0)_" Reverse then Resubmit attempt:")

 +14      ; reverse, then resubmit

 +15               NEW X

                   SET X=$$CATEG^ABSPOSUC(ABSBRXI)

 +16      ; it must be a successful reversal

 +17               IF X'="E REVERSAL ACCEPTED"

                       IF X'="PAPER REVERSAL"

                           Begin DoDot:2

 +18                           DO LOG^ABSPOSL($TEXT(+0)_" Cannot - reversal failed - "_X)

                           End DoDot:2

 +19              IF '$TEST

                       Begin DoDot:2

 +20      ; clear the flag

                           SET $PIECE(^ABSPT(ABSBRXI,1),U,12)=0

 +21                       DO LOG^ABSPOSL($TEXT(+0)_" Now resubmit")

 +22      ; resubmit it

                           DO RESUB1^ABSPOS6D(ABSBRXI)

 +23      ; and start background processing

                           DO TASK^ABSPOSIZ

                       End DoDot:2

 +24               DO RELSLOT^ABSPOSL

 +25               IF OLDSLOT

                       DO SETSLOT^ABSPOSL(OLDSLOT)

               End DoDot:1

 +26      ; And at random times, winnow the log files

 +27       IF $RANDOM(10000)=0

               Begin DoDot:1

 +28               NEW ZTRTN,ZTIO,ZTSAVE,ZTDTH

 +29      ; I $R(10)=0 winnow everything? INCOMPLETE - future

 +30               SET ZTRTN="SILENT^ABSPOSK(1)"

 +31      ; tomorrow early a.m.

                   SET ZTIO=""

                   SET ZTDTH=$$TADD^ABSPOSUD(DT,1)_".0222"

 +32               DO ^%ZTLOAD

               End DoDot:1

 +33       QUIT

 +34      ;

NEW57(RXI) ;EP - copy this ^ABSPT(RXI) into ^ABSPTL(N)

 +1        FOR

               LOCK +^ABSPTL:300

               IF $TEST

                   QUIT

               IF '$$IMPOSS^ABSPOSUE("L","RTI","LOCK ^ABSPTL",,"NEW57",$TEXT(+0))

                   QUIT

NEW57A     NEW N

           SET N=$PIECE(^ABSPTL(0),U,3)+1

 +1        NEW C

           SET C=$PIECE(^ABSPTL(0),U,4)+1

 +2        SET $PIECE(^ABSPTL(0),U,3,4)=N_U_C

 +3       ; should never happen

           IF $DATA(^ABSPTL(N))

               GOTO NEW57A

 +4        LOCK -^ABSPTL

 +5        MERGE ^ABSPTL(N)=^ABSPT(RXI)

 +6       ;

 +7       ; Indexing - First, fileman indexing

 +8        Begin DoDot:1

 +9            NEW DIK,DA

               SET DIK="^ABSPTL("

               SET DA=N

               NEW N

               DO IX1^DIK

           End DoDot:1

 +10      ;

 +11      ; The NON-FILEMAN index on RXI,RXR

 +12       Begin DoDot:1

 +13           NEW INDEX,A,B,TYPE

               SET TYPE=$EXTRACT(RXI,$LENGTH(RXI))

 +14           IF TYPE=1!(TYPE=2)

                   Begin DoDot:2

 +15                   SET A=$PIECE(^ABSPTL(N,1),U,11)

 +16                   SET B=$PIECE(^ABSPTL(N,1),U)

 +17                   SET INDEX=$SELECT(TYPE=1:"RXIRXR",TYPE=2:"POSTAGE")

                   End DoDot:2

 +18          IF '$TEST

                   IF TYPE=3

                       Begin DoDot:2

 +19                       SET A=$PIECE(^ABSPTL(N,0),U,7)

 +20      ; VCPT

                           SET B=$PIECE(^ABSPTL(N,1),U,3)

 +21      ; CPT IEN

                           SET B=$PIECE(^ABSVCPT(9002301,B,0),U)

 +22                       SET INDEX="OTHERS"

                       End DoDot:2

 +23          IF '$TEST

                   DO IMPOSS^ABSPOSUE("DB,P","TI","Bad TYPE="_TYPE,"in RXI="_RXI,"NEW57",$TEXT(+0))

 +24           SET ^ABSPTL("NON-FILEMAN",INDEX,A,B,N)=""

           End DoDot:1

 +25       QUIT N

 +26      ; $$PREV57(point to 57) returns pointer to previous transaction

 +27      ; for the same RXI,RXR - returns "" if no such

PREV57(N57) ; EP -

 +1        NEW RXI,RXR

           SET RXI=$PIECE(^ABSPTL(N57,1),U,11)

 +2        SET RXR=$PIECE(^ABSPTL(N57,1),U)

 +3        IF RXI=""!(RXR="")

               QUIT ""

 +4        QUIT $ORDER(^ABSPTL("NON-FILEMAN","RXIRXR",RXI,RXR,N57),-1)

 +5       ;

 +6       ; SETCSTAT - set the status for every prescription associated with

 +7       ; this claim

 +8       ;

SETCSTAT(CLAIM,STATUS) ;EP - ABSPOSAM

 +1        NEW ABSBRXI

 +2       ; different for reversals

           IF $$ISREVERS(CLAIM)

               Begin DoDot:1

 +3                SET ABSBRXI=$$RXI4REV(CLAIM)

                   IF ABSBRXI

                       DO SETSTAT(STATUS)

               End DoDot:1

               QUIT

 +4        SET ABSBRXI=""

 +5        FOR

               SET ABSBRXI=$ORDER(^ABSPT("AE",CLAIM,ABSBRXI))

               IF ABSBRXI=""

                   QUIT

               Begin DoDot:1

 +6                DO SETSTAT(STATUS)

               End DoDot:1

 +7        QUIT

ISREVERS(CLAIM) ;EP - ABSPOSP2

 +1       ; is this a reversal claim?  $$ returns 1 or 0

 +2        QUIT $PIECE($GET(^ABSPC(CLAIM,100)),"^",3)=11

RXI4REV(REVCLAIM) ; given IEN of reversal claim $$this to get RXI

 +1       ; The reversal claim must be associated with exactly one RXI.

 +2       ; MBN=Must Be Null

           NEW RET,MBN

 +3        SET RET=$ORDER(^ABSPT("AER",REVCLAIM,0))

           SET MBN=$ORDER(^(RET))

 +4       ; Uncomment the next line when doing certification tests! (ABSPOSC*)

 +5       ;Q RET

 +6       ; may not apply to certification testing!! SEE ABOVE.

           IF 'RET

               DO IMPOSS^ABSPOSUE("DB,P","TI","REVCLAIM="_REVCLAIM_" and ""AER"" index",,"RXI4REV",$TEXT(+0))

 +7        IF MBN'=""

               DO IMPOSS^ABSPOSUE("DB,P","TI","REVCLAIM="_REVCLAIM_" points back to multiple .59 entries",,"RXI4REV",$TEXT(+0))

 +8        QUIT RET

 +9       ;

 +10      ; SETCOMMS - for each prescription associated with this claim,

 +11      ; point back to the log of the comms session wherein xmit/rcv happened

 +12      ;

SETCOMMS(CLAIM,POINTER) ;EP - ABSPOSAM

 +1        NEW ABSBRXI

           SET ABSBRXI=""

 +2        FOR

               SET ABSBRXI=$ORDER(^ABSPT("AE",CLAIM,ABSBRXI))

               IF ABSBRXI=""

                   QUIT

               Begin DoDot:1

 +3                SET $PIECE(^ABSPT(ABSBRXI,0),"^",12)=POINTER

               End DoDot:1

 +4        QUIT

 +5       ;

 +6       ; SETRESU - Set Result  into ^ABSPT(ABSBRXI,2)

 +7       ;

 +8       ;    NOTE !!! NOTE !!! NOTE !!!  ABSBRXI must be set (not RXI) !!!

 +9       ;

SETRESU(RESULT,TEXT) ;EP - from many places

 +1        SET $PIECE(^ABSPT(ABSBRXI,2),U)=RESULT

 +2        IF $GET(TEXT)]""

               Begin DoDot:1

 +3                NEW X,Y

                   SET X=^ABSPT(ABSBRXI,2)

 +4                SET Y=$PIECE(X,U)

                   SET X=$PIECE(X,U,2,$LENGTH(X,U))

 +5                IF X=""

                       SET X=$EXTRACT(TEXT,1,255-$LENGTH(Y)-1)

 +6               IF '$TEST

                       SET X=$EXTRACT(TEXT_X,1,255-$LENGTH(Y)-1)

 +7                SET ^ABSPT(ABSBRXI,2)=Y_U_X

               End DoDot:1

 +8       ; look at the associated RESPONSE in ^ABSPR(

           IF RESULT=0

               QUIT

 +9       ;

 +10      ; For other RESULT codes, put a textual explanation in

 +11       QUIT

 +12      ;

 +13      ; SETCRESU - set the result code for every prescription assoc'd with

 +14      ; this claim

SETCRESU(CLAIM,RESULT,TEXT) ;

 +1        NEW ABSBRXI

           SET ABSBRXI=""

 +2        FOR

               SET ABSBRXI=$ORDER(^ABSPT("AE",CLAIM,ABSBRXI))

               IF ABSBRXI=""

                   QUIT

               Begin DoDot:1

 +3                DO SETRESU(RESULT,$GET(TEXT))

               End DoDot:1

 +4        QUIT

 +5       ;

 +6       ; STATI(X) gives a text version of what status code X means.

 +7       ;

STATI(X)  ;EP - from many places ; perhaps should be a Fileman file

 +1        IF X=99

               QUIT "Done"

 +2        IF X=50

               QUIT "Waiting for transmit"

 +3        IF X=30

               QUIT "Waiting for packet build"

 +4        IF X=0

               QUIT "Waiting to start"

 +5        IF X=10

               QUIT "Gathering claim info"

 +6        IF X=40

               QUIT "Packet being built"

 +7        IF X=60

               QUIT "Transmitting"

 +8        IF X=70

               QUIT "Receiving response"

 +9        IF X=80

               QUIT "Waiting to process response"

 +10       IF X=90

               QUIT "Processing response"

 +11       IF X=51

               QUIT "Wait for retry (comms error)"

 +12       IF X=31

               QUIT "Wait for retry (insurer asleep)"

 +13       IF X=19

               QUIT "Special grouping"

 +14      ; When you add new X=, account for these in FETSTAT^ABSPOS2

 +15       QUIT "?"_X_"?"

 +16      ;

 +17      ; RESULTI(X) gives a text version of what result code X means

 +18      ;

RESULTI(X) ;

 +1       ; say more

           IF X=0

               QUIT "See detail in ABSP RESPONSES file"

 +2       ; a catch-all default

           QUIT "Result code "_X

 +3       ;

RECEIPT(IEN57) ; This is where the receipt would go - taskman it to print in

 +1       ; background, somewhere, somehow

 +2        IF '$$DORECEI

               QUIT

 +3       ; Lookup printer for this pharmacy.

 +4       ; If none, lookup printer for this system, in general.

 +5       ; Also customizable:  routine for each pharmacy, each system.

 +6       ; Otherwise, a default-default routine for general receipt.

 +7       ;

 +8       ;S ZTIO=$P($G(^%ZIS(1,X,0)),U) Q:ZTIO=""

 +9       ;S X="N",%DT="ST" D ^%DT S ZTDTH=Y

 +10      ;S ZTRTN=""

 +11      ;S ZTSAVE("ClaimIEN")=""

 +12      ;D ^%ZTLOAD Q

 +13       QUIT

DORECEI() ; Should we print a receipt?

 +1       ; Site-specific conditions needed.

 +2       ; example:  electronic claims only;

 +3       ;   only claims with co-pay;

 +4       ;   etc.

 +5        QUIT 0

ABSPOSU.m