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

ACHSVPT.m

Go to the documentation of this file.
  1. ACHSVPT ; IHS/ITSC/PMF - UPDATE VENDOR PAYMENTS FILE ; [ 10/16/2001 8:16 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1. ;
  1. ;CALLED FROM
  1. ;ACHSAJ1+146
  1. ;ACHSPA0+72
  1. ;
  1. ;INPUT IS ACHSDAP ;AMOUNT TO BE ADDED TO
  1. ;
  1. ;CHS VENDOR PAYMENTS^9002075
  1. ;
  1. ;IF FACILITY ENTRY NOT THERE CREATE NEW ONE
  1. ;AGAIN A CASE WHERE FILEMAN SHOULD HANDLE THIS
  1. I '$D(^ACHSVPMT(DUZ(2))) D
  1. .S $P(^ACHSVPMT(DUZ(2),0),U)=DUZ(2)
  1. .S ^ACHSVPMT("B",DUZ(2),DUZ(2))=""
  1. .S $P(^ACHSVPMT(0),U,3)=DUZ(2),$P(^(0),U,4)=$P(^(0),U,4)+1 ;ENTRY COUNT
  1. ;
  1. ;IF NO 0 NODE FOR SUB-FILE 'VENDOR NAME' 9002075.01 CREATE IT
  1. I '$D(^ACHSVPMT(DUZ(2),1,0)) D
  1. .S ^ACHSVPMT(DUZ(2),1,0)=$$ZEROTH^ACHS(9002075,1)
  1. .S $P(^ACHSVPMT(DUZ(2),1,0),U,3)=ACHSPROV ;LAST ENTRY USED
  1. .S $P(^ACHSVPMT(DUZ(2),1,0),U,4)=0 ;ENTRY COUNT
  1. ;
  1. ;IF NOT VENDOR ENTRY CREATE ONE
  1. I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV)) D
  1. .S $P(^ACHSVPMT(DUZ(2),1,0),U,3)=ACHSPROV ;LAST ENTRY USED
  1. .S $P(^ACHSVPMT(DUZ(2),1,0),U,4)=$P(^ACHSVPMT(DUZ(2),1,0),U,4)+1 ;LAST ENTRY
  1. .S ^ACHSVPMT(DUZ(2),1,ACHSPROV,0)=ACHSPROV
  1. .S ^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,ACHSPROV)=""
  1. ;
  1. ;IF NO 0 NODE FOR SUB-FILE 'FISCAL YEAR' 9002075.02 CREATE IT
  1. I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0)) D
  1. .S ^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0)=$$ZEROTH^ACHS(9002075,1,1)
  1. ;
  1. ;IF FISCAL YEAR ENTRY DOESN'T EXIST CREATE IT
  1. I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY)) D
  1. .S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,3)=ACHSCFY
  1. .S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,4)=$P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,0),U,4)+1
  1. ;
  1. ;IF THE FISCAL YEAR 0 DATA NODE ISN'T THERE CREATE IT
  1. I '$D(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0)) S ^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0)=ACHSCFY_U_ACHSDAP_U_DT G END
  1. ;
  1. ;GET 'DOLLAR AMT PAID'
  1. S X=$P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,2)
  1. ;
  1. ;INCREMENT IT BY ????? 'IHS PAYMENT AMOUNT' FROM TRANSACTION FILE
  1. ;OR VAR ACHSADAM WHICH IS ENTERED IN ^ACHSAJ BY THE USER AT THE
  1. ;"Payment Adjustment Amount" PROMPT
  1. ;HAVE TO LOOK CLOSE AT WHAT ACHSDAP IS AT THE TWO CALLS MADE
  1. S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,2)=X+ACHSDAP
  1. S $P(^ACHSVPMT(DUZ(2),1,ACHSPROV,1,ACHSCFY,0),U,3)=DT ;'LAST UPDATE DATE'
  1. END ;
  1. K ACHSDAP
  1. Q
  1. ;