ABSPOSN8.m

ABSPOSN8 ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ;  [ 09/12/2002  10:17 AM ]

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

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

 ; Calculate payments F billing ITEM.

 ;

 ; Inputs:   BITEMIEN  - Billing ITEM internal entry number.

 ;

 ; Returns:  TotPay    - Total of payments.

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

PAYINFO(BITEMIEN) ;

 N TOTPAY,J

 ;

 Q:$G(BITEMIEN)="" 0

 ;

 ; Loop through the payment multiple of the billing ITEMs file.

 S (TOTPAY,J)=0

 F  S J=$O(^ABSBITMS(9002302,BITEMIEN,7,J)) Q:'J  D

 . S TOTPAY=TOTPAY+$P($G(^ABSBITMS(9002302,BITEMIEN,7,J,0)),U,2)

 ;

 Q TOTPAY

ABSPOSN8  ; IHS/FCS/DRS - NCPDP Fms F ILC A/R ;  [ 09/12/2002  10:17 AM ]

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

 +2       ;--------------------------------------------------------------------

 +3       ; Calculate payments F billing ITEM.

 +4       ;

 +5       ; Inputs:   BITEMIEN  - Billing ITEM internal entry number.

 +6       ;

 +7       ; Returns:  TotPay    - Total of payments.

 +8       ;--------------------------------------------------------------------

PAYINFO(BITEMIEN) ;

 +1        NEW TOTPAY,J

 +2       ;

 +3        IF $GET(BITEMIEN)=""

               QUIT 0

 +4       ;

 +5       ; Loop through the payment multiple of the billing ITEMs file.

 +6        SET (TOTPAY,J)=0

 +7        FOR 

               SET J=$ORDER(^ABSBITMS(9002302,BITEMIEN,7,J))

               IF 'J

                   QUIT 

               Begin DoDot:1

 +8                SET TOTPAY=TOTPAY+$PIECE($GET(^ABSBITMS(9002302,BITEMIEN,7,J,0)),U,2)

               End DoDot:1

 +9       ;

 +10       QUIT TOTPAY