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

PRCHNPOC.m

Go to the documentation of this file.
  1. PRCHNPOC ;RB-MNTFW-CONT. OF EDIT PO ;8/7/14 19:48
  1. V ;;5.1;IFCAP;**191**;Oct 20, 2000;Build 4
  1. ;Per VA Directive 6402, this routine should not be modified
  1. ;
  1. ;PRC*5.1*191 Prompt Pay call made from PRCHNPO1 to insure
  1. ; ONLY one entry is added/edited with the PP
  1. ; field defined as multiple.
  1. ;
  1. PPEDIT ;Prompt payment edit
  1. N DIC,DIE,DA,DR,Y,PRCHX,PRCHXX,PRCHVAL,PRCHDA,%X,%Y,PRCHPP
  1. S PRCHPP=$O(^PRC(442,PRCHPO,5,0)) D:PRCHPP
  1. . S (PRCHDA,DA)=PRCHPP
  1. . S DR=".01//^S X=""NET"";1//^S X=30"
  1. . S DA(1)=PRCHPO,DIE="^PRC(442,"_DA(1)_",5," D ^DIE
  1. I 'PRCHPP S DA(1)=PRCHPO,DIC="^PRC(442,"_DA(1)_",5,",DIC(0)="AELQZ",DIC("B")="NET" D ^DIC Q:Y<0 S (PRCHDA,DA)=+Y D
  1. . S $P(^PRC(442,PRCHPO,5,0),U,2)=$P(^DD(442,9.2,0),U,2)
  1. . S DA(1)=PRCHPO,DIE="^PRC(442,"_DA(1)_",5,"
  1. . S DR=".01//^S X=""NET"";1//^S X=30"
  1. . D ^DIE
  1. QUIT