ABSPOS02.m

ABSPOS02 ; IHS/FCS/DRS - 9002313.02 utilities ;

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

 Q

 ; General utilities for retrieval from 9002313.02, Claims

 ; Not sure who, if anybody, uses this!

BILLED(N)          ; total amount billed on a given Claim Submission

 ; (up to 4 prescriptions)         

 N RX,TOT S (TOT,RX)=0

 F  S RX=$O(^ABSPC(N,400,RX)) Q:'RX  D

 . S TOT=TOT+$$BILLED1(N,RX)

 Q TOT

BILLED1(N,RX)      ; amount billed on a single Claim Submission

 ; Try Gross Amount Due, and if that's zero, Usual and Customary

 S X=$$430(N,RX)

 I 'X S X=$$426(N,RX)

 Q X

FIRSTRX(N)         Q $O(^ABSPC(N,400,0))

DFF2EXT(X)         Q $$DFF2EXT^ABSPECFM(X)

426(M,N) Q $$400(M,N,26) ; Usual and Customary

430(M,N) Q $$400(M,N,30) ; Gross Amount Due

400(M,N,J)         ; field #400+J signed numeric

 N X S X=$P(^ABSPC(M,400,N,400),U,J)

 I $E(X,1,2)?2U S X=$E(X,3,$L(X))

 S X=$$DFF2EXT(X)

 Q X

ABSPOS02  ; IHS/FCS/DRS - 9002313.02 utilities ;

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

 +2        QUIT 

 +3       ; General utilities for retrieval from 9002313.02, Claims

 +4       ; Not sure who, if anybody, uses this!

BILLED(N) ; total amount billed on a given Claim Submission

 +1       ; (up to 4 prescriptions)         

 +2        NEW RX,TOT

           SET (TOT,RX)=0

 +3        FOR 

               SET RX=$ORDER(^ABSPC(N,400,RX))

               IF 'RX

                   QUIT 

               Begin DoDot:1

 +4                SET TOT=TOT+$$BILLED1(N,RX)

               End DoDot:1

 +5        QUIT TOT

BILLED1(N,RX) ; amount billed on a single Claim Submission

 +1       ; Try Gross Amount Due, and if that's zero, Usual and Customary

 +2        SET X=$$430(N,RX)

 +3        IF 'X

               SET X=$$426(N,RX)

 +4        QUIT X

FIRSTRX(N)  QUIT $ORDER(^ABSPC(N,400,0))

DFF2EXT(X)  QUIT $$DFF2EXT^ABSPECFM(X)

426(M,N)  ; Usual and Customary

           QUIT $$400(M,N,26)

430(M,N)  ; Gross Amount Due

           QUIT $$400(M,N,30)

400(M,N,J) ; field #400+J signed numeric

 +1        NEW X

           SET X=$PIECE(^ABSPC(M,400,N,400),U,J)

 +2        IF $EXTRACT(X,1,2)?2U

               SET X=$EXTRACT(X,3,$LENGTH(X))

 +3        SET X=$$DFF2EXT(X)

 +4        QUIT X