ACHSPA0A.m

ACHSPA0A ; IHS/ITSC/PMF - DOCUMENT PAYMENT (CONT.) ;   [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 Q

 ;

INTRM ;EP - Sets interim payment nodes.

 ;

 I '$$LOCK^ACHS("^ACHSF(DUZ(2),""D"",ACHSDIEN,""IP"")","+") W *7,!,"LOCK failed at INTRM^ACHSPA0A on '^ACHSF(",DUZ(2),",""D"",",ACHSDIEN,",""IP"")'.",!,"NOTIFY PROGRAMMER" D RTRN^ACHS Q

 ;

 S:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")) ^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")=0_U_0_U_0

 S:'$D(ACHSPDAT) ACHSPDAT=ACHSEOBD

 ;

 ;SET 'INTERIM PAYMENT TOTAL' PLUS 'IHS PAYMENT AMOUNT'

 S ACHSTIP=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")),U)+ACHSPAMT

 S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U)=ACHSTIP

 ;

 ;INCREMENT 'NUMBER OF INTERIM PAYMENTS'

 S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U,2)=$P(^("IP"),U,2)+1

 ;

 ;'LAST INTERIM PAYMENT DATE'

 S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U,3)=ACHSPDAT

 ;

 Q:'$D(ACHSISAO)     ;IS AREA OFFICE?

 Q:(ACHSISAO'=0)     ;CHECKS TO SEE IF 0 TOO ???????

 ;

 I '$D(ACHSTOT(ACHSY,"INTERIM PAYMENTS")) S ACHSTOT(ACHSY,"INTERIM PAYMENTS")="0^0"

 S $P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U)=$P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U)+ACHSPAMT

 S $P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U,2)=$P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U,2)+1

 Q

 ;

ACHSPA0A  ; IHS/ITSC/PMF - DOCUMENT PAYMENT (CONT.) ;   [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3        QUIT 

 +4       ;

INTRM     ;EP - Sets interim payment nodes.

 +1       ;

 +2        IF '$$LOCK^ACHS("^ACHSF(DUZ(2),""D"",ACHSDIEN,""IP"")","+")

               WRITE *7,!,"LOCK failed at INTRM^ACHSPA0A on '^ACHSF(",DUZ(2),",""D"",",ACHSDIEN,",""IP"")'.",!,"NOTIFY PROGRAMMER"

               DO RTRN^ACHS

               QUIT 

 +3       ;

 +4        IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"))

               SET ^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")=0_U_0_U_0

 +5        IF '$DATA(ACHSPDAT)

               SET ACHSPDAT=ACHSEOBD

 +6       ;

 +7       ;SET 'INTERIM PAYMENT TOTAL' PLUS 'IHS PAYMENT AMOUNT'

 +8        SET ACHSTIP=$PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")),U)+ACHSPAMT

 +9        SET $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U)=ACHSTIP

 +10      ;

 +11      ;INCREMENT 'NUMBER OF INTERIM PAYMENTS'

 +12       SET $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U,2)=$PIECE(^("IP"),U,2)+1

 +13      ;

 +14      ;'LAST INTERIM PAYMENT DATE'

 +15       SET $PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U,3)=ACHSPDAT

 +16      ;

 +17      ;IS AREA OFFICE?

           IF '$DATA(ACHSISAO)

               QUIT 

 +18      ;CHECKS TO SEE IF 0 TOO ???????

           IF (ACHSISAO'=0)

               QUIT 

 +19      ;

 +20       IF '$DATA(ACHSTOT(ACHSY,"INTERIM PAYMENTS"))

               SET ACHSTOT(ACHSY,"INTERIM PAYMENTS")="0^0"

 +21       SET $PIECE(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U)=$PIECE(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U)+ACHSPAMT

 +22       SET $PIECE(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U,2)=$PIECE(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U,2)+1

 +23       QUIT 

 +24      ;