Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSPA0A

ACHSPA0A.m

Go to the documentation of this file.
  1. ACHSPA0A ; IHS/ITSC/PMF - DOCUMENT PAYMENT (CONT.) ; [ 10/16/2001 8:16 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1. ;
  1. Q
  1. ;
  1. INTRM ;EP - Sets interim payment nodes.
  1. ;
  1. 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
  1. ;
  1. S:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")) ^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")=0_U_0_U_0
  1. S:'$D(ACHSPDAT) ACHSPDAT=ACHSEOBD
  1. ;
  1. ;SET 'INTERIM PAYMENT TOTAL' PLUS 'IHS PAYMENT AMOUNT'
  1. S ACHSTIP=$P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP")),U)+ACHSPAMT
  1. S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U)=ACHSTIP
  1. ;
  1. ;INCREMENT 'NUMBER OF INTERIM PAYMENTS'
  1. S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U,2)=$P(^("IP"),U,2)+1
  1. ;
  1. ;'LAST INTERIM PAYMENT DATE'
  1. S $P(^ACHSF(DUZ(2),"D",ACHSDIEN,"IP"),U,3)=ACHSPDAT
  1. ;
  1. Q:'$D(ACHSISAO) ;IS AREA OFFICE?
  1. Q:(ACHSISAO'=0) ;CHECKS TO SEE IF 0 TOO ???????
  1. ;
  1. I '$D(ACHSTOT(ACHSY,"INTERIM PAYMENTS")) S ACHSTOT(ACHSY,"INTERIM PAYMENTS")="0^0"
  1. S $P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U)=$P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U)+ACHSPAMT
  1. S $P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U,2)=$P(ACHSTOT(ACHSY,"INTERIM PAYMENTS"),U,2)+1
  1. Q
  1. ;