- 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 ;
