ABSPOSU ; IHS/FCS/DRS - utilities ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
Q
; 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
Q
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
Q
;
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
D
. N DIK,DA S DIK="^ABSPTL(",DA=N N N D IX1^DIK
;
; The NON-FILEMAN index on RXI,RXR
D
. 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)
Q
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
Q
;
; 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
Q
;
; 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))
Q
;
; 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
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
