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

PRCAGF.m

Go to the documentation of this file. 
  1. PRCAGF ;WASH-ISC@ALTOONA,PA/CMS-Print Form Letters ;5/1/95  3:04 PM
  1. V ;;4.5;Accounts Receivable;**1,48,141,190,225,259,415**;Mar 20, 1995;Build 1
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. EN(DEB,SB,PRNT) ;entry send Debtor number and statemet bal
  1.  NEW PRCABN,CR,NOT,STAT
  1.  S (CR,NOT)=0 I '$D(SITE) D SITE^PRCAGU
  1.  F STAT=16,42 F PRCABN=0:0 S PRCABN=$O(^PRCA(430,"AS",DEB,STAT,PRCABN)) Q:'PRCABN  D
  1.  .I $P(^RCD(340,DEB,0),U,1)'["DPT",$G(^PRCA(430,PRCABN,1))>0 Q
  1.  .I $P(^RCD(340,DEB,0),U)'["DPT",($P($G(^PRCA(430,PRCABN,6)),U,4)>0) Q
  1.  .D LT(PRCABN,$G(SB))
  1.  Q
  1. LT(PRCABN,SB,REPNOT) ;find which letter to print needs Site variable
  1.  NEW BY,CAT,CE,CN,CU,CV,EH,EXE,FR,I,INE,IOP,LET,LT,PG,TO,VEN,X,TOPLTR
  1.  I '$D(^PRCA(430,PRCABN,0)) Q
  1.  S:'$D(CR) (NOT,CR)="" S:'$G(DEB) DEB=+$P(^PRCA(430,PRCABN,0),U,9)
  1.  S CAT=$P($G(^PRCA(430,PRCABN,0)),U,2),LET=$G(^PRCA(430,PRCABN,6)) Q:CAT=""
  1.  I $G(SB)="",CAT=26,^PRCA(430,PRCABN,7) S SB=-(+^(7))
  1.  I $G(SB)="" S X=$G(^PRCA(430,PRCABN,7)) F I=1:1:5 S SB=+$G(SB)+$P(X,U,I)
  1.  I SB<0 Q:CR  S LT=$O(^RC(343,"B","CREDIT",0)) D PRT(LT,PRCABN) S CR=1 Q
  1.  I $P($G(^PRCA(430,PRCABN,1)),U,1),$P($G(^RCD(340,$P(^PRCA(430,PRCABN,0),U,9),0)),U,1)[";DPT" Q
  1.  I $G(REPNOT)>0 S:REPNOT=4 REPNOT=3 S $P(LET,U,REPNOT)=""
  1.  I NOT=0,+$$GET1^DIQ(430.2,CAT_",",1.07,"I") D  ; PRCA*4.5*415
  1.  .I SITE("SUP") S NOT=1 Q
  1.  .S LT=$S('$G(BBAL("INT")):"FL 4-513",1:"FL 4-513w")
  1.  .S LT=$O(^RC(343,"B",LT,0)) D PRT(LT,PRCABN) S NOT=1
  1.  .Q
  1.  S INE=$O(^PRCA(430.2,"AC",20,0)),EH=$O(^PRCA(430.2,"AC",25,0)),CV=$O(^PRCA(430.2,"AC",34,0))
  1.  S CU=$O(^PRCA(430.2,"AC",38,0))
  1.  I CAT=INE!(CAT=CV)!(CAT=CU),$P(LET,U,1)="" S LT=$O(^RC(343,"B","FL 4-480",0)) D PRT(LT,PRCABN) Q
  1.  I CAT=EH,$P(LET,U,1)="" S LT=$O(^RC(343,"B","FL 4-481",0)) D PRT(LT,PRCABN) Q
  1.  I CAT=EH!(CAT=INE)!(CAT=CV)!(CAT=CU),$P(LET,U,2)="" S LT=$O(^RC(343,"B","FL 4-482",0)) D PRT(LT,PRCABN) Q
  1.  ;THIRD PARAMETER (1) FOR CALLING PRINT SUBROUTINE INSTRUCTS
  1.  ;SOFTWARE TO PRINT "TOP ATTACHMENT LETTER"
  1.  I CAT=EH!(CAT=INE)!(CAT=CV)!(CAT=CU),SB>599.99,SB<1200,$P(LET,U,3)="" S LT=$O(^RC(343,"B","FL 4-484",0)) D PRT(LT,PRCABN,1) Q
  1.  I CAT=EH!(CAT=INE)!(CAT=CV)!(CAT=CU),SB>1199.99,$P(LET,U,3)="" S LT=$O(^RC(343,"B","FL 4-485",0)) D PRT(LT,PRCABN,1) Q
  1.  S VEN=","_$O(^PRCA(430.2,"AC",6,0))_","_$O(^PRCA(430.2,"AC",7,0))_","_$O(^PRCA(430.2,"AC",11,0))_",",EXE=$O(^PRCA(430.2,"AC",13,0)),CE=$O(^PRCA(430.2,"AC",14,0))
  1.  I CAT=EXE,$P(LET,U,1)="" S LT=$O(^RC(343,"B","FL 4-520b",0)) D PRT(LT,PRCABN) Q
  1.  I CAT=CE,$P(LET,U,1)="" S LT=$O(^RC(343,"B","FL 4-520a",0)) D PRT(LT,PRCABN) Q
  1.  I VEN[(","_CAT_","),$P(LET,U,1)="" S LT=$O(^RC(343,"B","FL 4-521",0)) D PRT(LT,PRCABN) Q
  1.  I CAT=CE!(CAT=EXE)!(VEN[(","_CAT_",")),$P(LET,U,2)="" S LT=$O(^RC(343,"B","FL 4-483a",0)) D PRT(LT,PRCABN) Q
  1.  ;I CAT=CE!(CAT=EH)!(CAT=INE)!(CAT=EXE)!(VEN[(","_CAT_","))!(CAT=CV)!(CAT=CU),$P(LET,U,3)="",SB>25,SB<600 S LT=$O(^RC(343,"B","FL 4-483",0)) D PRT(LT,PRCABN,1) Q
  1.  ;CHANGE GREATER THAN $25 TO GREATER THAN $0 - PRCA*4.5*259
  1.  I CAT=CE!(CAT=EH)!(CAT=INE)!(CAT=EXE)!(VEN[(","_CAT_","))!(CAT=CV)!(CAT=CU),$P(LET,U,3)="",SB>0,SB<600 S LT=$O(^RC(343,"B","FL 4-483",0)) D PRT(LT,PRCABN,1) Q
  1.  I CAT=CE!(CAT=EXE)!(VEN[(","_CAT_",")),SB>599.99,$P(LET,U,3)="" S LT=$O(^RC(343,"B","FL 4-485",0)) D PRT(LT,PRCABN,1) Q
  1.  Q
  1. PRT(LT,PRCABN,TOP) ;print letter
  1.  NEW DA,DIWF,DIWL,DIWR,LINE,LTP,X,D0
  1.  S TOP=$G(TOP),LTP=0 I '$D(^RC(343,LT,0)) G PRTQ
  1.  I LT'=+$O(^RC(343,"B","CREDIT",0)),LT'=+$O(^RC(343,"B","FL 4-513",0)),LT'=+$O(^RC(343,"B","FL 4-513w",0)) S LTP=1 ;s ltp if letter (not statement)
  1.  S DEB=+$P(^PRCA(430,PRCABN,0),U,9)
  1.  S NAM=$$NAM^RCFN01(DEB),SSN=$$SSN^RCFN01(DEB),SSN=$S(SSN=-1:"",1:SSN)
  1.  I LTP D LTH ;print header on letter
  1.  K ^UTILITY($J) ;print main body text from 343
  1.  S ^UTILITY($J,1)="W "_IOF
  1.  F LINE=0:0 S LINE=$O(^RC(343,LT,1,LINE)) Q:'LINE  S X=$G(^(LINE,0)) I X]"" W:($Y+2)>IOSL @IOF S DIWL=1,DIWR=80,DIWF="W" D ^DIWP
  1.  D ^DIWW S:$G(PRNT)="FL" PRNT=1 K ^UTILITY($J)
  1.  I LTP,",15,16,17,41,42,"[(","_$P($G(^PRCA(430,PRCABN,0)),U,2)_",") D DESC(PRCABN) ;print bill desc from 430 for cat. Ex-Emp, Curr Emp., Vendor, Cwt & Parking Fees
  1.  ;CALL TO PRINT "TOP ATTACHMENT LETTER" FOR FL 4-483,FL 4-484,FL 4-485
  1.  I TOP D TOP
  1.  I LTP D PAY^PRCAGF1 W !,$P(^RC(343,LT,0),U,1) ;print letter payment remittance and Form number
  1. PRTQ Q
  1. LTH ;print letter header
  1.  NEW ADD,X,Y
  1.  W @IOF D:'$D(SITE) SITE^PRCAGU
  1.  S ADD=$$SADD^RCFN01(8) I ADD="" S ADD=$$SADD^RCFN01(1)
  1.  W !!,?30,"Department of Veterans Affairs"
  1.  F Y=1:1:3 I $P(ADD,U,Y)]"" W !,?32,$P(ADD,U,Y)
  1.  W !,?32,$P(ADD,U,4)_", "_$P(ADD,U,5)_"  "_$P(ADD,U,6)
  1.  W !!!!,?50,"In Reply Refer To:"
  1.  W !,?50,"File No./SSAN: ",$S($D(RCIRSTOT):SSN,1:$P(^PRCA(430,PRCABN,0),U,1))
  1.  W !,?14,NAM
  1.  S ADD=$$DADD^RCAMADD(DEB,1) ; Get debtor address (confidential if applicable)
  1.  F Y=1:1:3 I $P(ADD,U,Y)]"" W !,?14,$P(ADD,U,Y) I Y=1 W ?50 X SITE("SCAN")
  1.  W !,?14,$P(ADD,U,4)_", "_$P(ADD,U,5)_"  "_$P(ADD,U,6)
  1.  S Y=DT X ^DD("DD") W !!!!!!,Y,!!
  1.  Q
  1. DESC(PRCABN) ;print description multiple from file 430
  1.  NEW PRCABT,X,Y
  1.  I '$G(PRCABN),$G(^PRCA(430,PRCABN,100))'=3 Q
  1.  W !!,"Detailed Description:"
  1.  D DES^PRCABD(PRCABN,3) W !
  1.  Q
  1. TOP ;PRINT TOP ATTACHMENT LETTER FOR FL 4-483,FL 4-484, FL 4-485
  1.  S TOPLTR=$O(^RC(343,"B","TOP ATTACHMENT LETTER",0))
  1.  Q:'TOPLTR  K ^UTILITY($J)
  1.  S ^UTILITY($J,1)="W "_IOF
  1.  F LINE=0:0 S LINE=$O(^RC(343,TOPLTR,1,LINE)) Q:'LINE  S X=$G(^(LINE,0)) I X]"" W:($Y+2)>IOSL @IOF S DIWL=1,DIWR=80,DIWF="W" D ^DIWP
  1.  D ^DIWW K ^UTILITY($J)
  1.  Q