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

FBUCUTL2.m

Go to the documentation of this file.
  1. FBUCUTL2 ;ALBISC/TET - UTILITY (CONTINUED) ;2/12/2003
  1. ;;3.5;FEE BASIS;**23,32,38,52**;JAN 30, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ADDRESS(FBUCA) ;set up address (FBADD) and carbon copy address (FBADDCC)
  1. ;INPUT: FBUCA = current (or after) zero node for UC (file #162.7)
  1. ;OUTPUT: FBADD( array, subscripted by sequential number; FBADD = count
  1. ; FBADDCC( array, subscripted by sequential number; FBADDCC=count
  1. N FBDA,FBGL,FBSUB
  1. K FBADD,FBADDCC
  1. S FBSUB=$P(FBUCA,U,23)
  1. S:FBSUB']"" FBSUB=$P(FBUCA,U,4)_";DPT("
  1. S FBDA=+$P(FBSUB,";")
  1. I FBSUB["FBAAV" D VENADD(FBDA,.FBADD) D VETADD($P(FBUCA,U,4),.FBADDCC)
  1. I FBSUB["DPT" D VETADD(FBDA,.FBADD) D VENADD($P(FBUCA,U,3),.FBADDCC)
  1. I FBSUB["VA(200" D OTHADD(FBDA,.FBADD) D VETADD($P(FBUCA,U,4),.FBADDCC)
  1. Q
  1. VETADD(DFN,FBARR) ;set up veteran address
  1. ;INPUT: DFN = veteran ien
  1. ; FBARR array that will hold the address (passed by reference)
  1. ;VAPA("CD") - date for ADD^VADPT if not defined then NOW will be used
  1. ; VAPA will be killed!
  1. ;
  1. ;OUTPUT FBARR array will contain the veteran mailing address,
  1. ; subscripted by sequential number; FBARR = line count
  1. N FBCT,FBI
  1. K FBARR
  1. S FBCT=0
  1. I $G(DFN)>0 D
  1. .S FBCT=FBCT+1,FBARR(FBCT)=$$GETNAME^FBUCLET1(DFN,2,"G")
  1. .D ADD^VADPT I 'VAERR D K VAPA,VAERR
  1. . . I $$ACTIVECC^FBAACO0() D Q
  1. . . . F FBI=13,14,15 S:$G(VAPA(FBI))]"" FBCT=FBCT+1,FBARR(FBCT)=$G(VAPA(FBI))
  1. . . . S FBCT=FBCT+1,FBARR(FBCT)=$S($G(VAPA(16))]"":$G(VAPA(16)),1:" ")_" "_$S($P($G(VAPA(17)),U,2)]"":$P($G(VAPA(17)),U,2),1:" ")_" "_$P($G(VAPA(18)),U,2)
  1. ..F FBI=1,2,3 S:VAPA(FBI)]"" FBCT=FBCT+1,FBARR(FBCT)=VAPA(FBI)
  1. ..S FBCT=FBCT+1,FBARR(FBCT)=$S(VAPA(4)]"":VAPA(4),1:" ")_" "_$S($P(VAPA(5),U,2)]"":$P(VAPA(5),U,2),1:" ")_" "_$S('+$G(VAPA(11)):VAPA(6),$P(VAPA(11),U,2)]"":$P(VAPA(11),U,2),1:VAPA(6))
  1. S FBARR=FBCT
  1. Q
  1. ;
  1. VENADD(FBV,FBARR) ;set up vendor address
  1. ;INPUT: FBV = vendor ien (file 161.2)
  1. ; FBARR array that will hold the address (passed by reference)
  1. ;OUTPUT FBARR array will contain the vendor mailing address,
  1. ; subscripted by sequential number; FBARR = line count
  1. N FBCT,FBP,FBSTATE,FBZ
  1. K FBARR
  1. S FBCT=0
  1. I $G(FBV)>0 D
  1. .S FBZ=$G(^FBAAV(FBV,0))
  1. .S FBCT=FBCT+1,FBARR(FBCT)=$P(FBZ,U)
  1. .I FBARR(1)["," S FBARR(1)=$P(FBARR(1),",",2)_" "_$P(FBARR(1),",")
  1. .S FBSTATE=$P($G(^DIC(5,+$P(FBZ,U,5),0)),U,2)
  1. .F FBP=3,14 S:$P(FBZ,U,FBP)]"" FBCT=FBCT+1,FBARR(FBCT)=$P(FBZ,U,FBP)
  1. .S FBCT=FBCT+1,FBARR(FBCT)=$S($P(FBZ,U,4)]"":$P(FBZ,U,4),1:" ")_" "_$S(FBSTATE]"":FBSTATE,1:" ")_" "_$P(FBZ,U,6)
  1. S FBARR=FBCT
  1. Q
  1. OTHADD(FBDA,FBARR) ;set up other party address
  1. ;INPUT: FBDA = other party ien (file 200)
  1. ; FBARR array that will hold the address (passed by reference)
  1. ;OUTPUT FBARR array will contain the vendor mailing address,
  1. ; subscripted by sequential number; FBARR = line count
  1. N FBCT,FBP,FBSTATE,FBZ11
  1. K FBARR
  1. S FBCT=0
  1. I $G(FBDA)>0 D
  1. .S FBCT=FBCT+1,FBARR(FBCT)=$$GETNAME^FBUCLET1(FBDA,200,"G")
  1. .S FBZ11=$G(^VA(200,FBDA,.11))
  1. .I FBZ11]"" D
  1. ..S FBSTATE=$P($G(^DIC(5,+$P(FBZ11,U,5),0)),U,2)
  1. ..F FBP=1,2,3 S:$P(FBZ11,U,FBP)]"" FBCT=FBCT+1,FBARR(FBCT)=$P(FBZ11,U,FBP)
  1. ..S FBCT=FBCT+1,FBARR(FBCT)=$S($P(FBZ11,U,4)]"":$P(FBZ11,U,4),1:" ")_" "_$S(FBSTATE]"":FBSTATE,1:" ")_" "_$P(FBZ11,U,6)
  1. S FBARR=FBCT
  1. Q
  1. STATADD ;station address, from fee basis site parameter file
  1. ;INPUT: nothing
  1. ;OUTPUT: FBSADD( array of station name,address, and number
  1. ;called when printing a letter, used if letterhead not used
  1. K ^UTILITY("DIQ1",$J) N DIC,DA,DIQ,DR,FBCT,FBP S DIC="^FBAA(161.4,",DA=1,DIQ="FBSADD(" D
  1. .S DR="1:2;16",DIQ(0)="EN" D EN^DIQ1
  1. .S DR="3:5;35.6",DIQ(0)="E" D EN^DIQ1
  1. .;S DR=27,DIQ(0)="IN" D EN^DIQ1
  1. I $G(FBSADD(161.4,1,16,"E"))]"" S FBSADD(161.4,1,2.5,"E")=FBSADD(161.4,1,16,"E") K FBSADD(161.4,1,16,"E") ;set street address lines together
  1. S FBSADD(161.4,1,.01,"E")=$G(FBSADD(161.4,1,35.6,"E")) K FBSADD(161.4,1,35.6,"E") ;re-set so name is first
  1. S (FBCT,FBP)=0 F S FBP=$O(FBSADD(161.4,1,FBP)) Q:FBP'<3!('FBP) S:$G(FBSADD(161.4,1,FBP,"E"))]"" FBCT=FBCT+1,FBSADD(FBCT)=FBSADD(161.4,1,FBP,"E") K FBSADD(161.4,1,FBP)
  1. S FBCT=FBCT+1,FBSADD(FBCT)=$S($G(FBSADD(161.4,1,3,"E"))]"":FBSADD(161.4,1,3,"E"),1:" ")_" "_$S($G(FBSADD(161.4,1,4,"E"))]"":FBSADD(161.4,1,4,"E"),1:" ")_" "_$G(FBSADD(161.4,1,5,"E")) F FBP=3:1:5 K FBSADD(161.4,1,FBP)
  1. K ^UTILITY("DIQ1",$J) Q
  1. STANUM ;get station number
  1. ;INPUT: nothing
  1. ;OUTPUT: FBSTANUM = station number of PSA, as set in FB site parameter
  1. K ^UTILITY("DIQ1",$J) N DA,DIC,DIQ,DR S DA=1,DIC="^FBAA(161.4,",DIQ="FBSTA(",DR=27,DIQ(0)="IN" D EN^DIQ1 K ^UTILITY("DIQ1",$J)
  1. S FBSTANUM=$G(FBSTA(161.4,1,27,"I")) I FBSTANUM]"" S FBSTANUM=$P($G(^DIC(4,FBSTANUM,99)),U)
  1. K FBSTA(161.4) Q
  1. LETTER(FBORDER,FB1725) ;get letter ien number
  1. ;INPUT: FBORDER = order number of status
  1. ; FB1725 = (optional) =true to select a 38 U.S.C. 1725 letter
  1. ;OUTPUT: ien of letter or 0
  1. N Y,PIECE
  1. S Y=+$O(^FB(162.92,"AO",FBORDER,0))
  1. S PIECE=$S($G(FB1725):6,1:5)
  1. Q +$P($G(^FB(162.92,Y,0)),"^",PIECE)
  1. ;
  1. TXT(FBGL,FBIEN,FBN,DIWF,DIWL,FBLET,FBCC,FBCCI,FBLBL) ;write txt
  1. ;INPUT: FBGL = global root
  1. ; FBIEN = internal entry number of file
  1. ; FBN = node where wp info resides
  1. ; DIWF = format
  1. ; DIWL = left offset
  1. ; FBLET = 1 if coming from letter (optional)
  1. ; FBCC = 1 if CC address will print at bottom of page (optional)
  1. ; passed by reference
  1. ; FBCCI = number lines needed for CC address (required if FBCC=1)
  1. ; FBLBL = label text to print at beginning of 1st line (optional)
  1. N FBI,FBNODE,FBTXT,X S FBNODE=FBGL_FBIEN_","_FBN S FBLET=$S('$D(FBLET):0,1:+FBLET)
  1. I $D(@(FBNODE_")")) S X=$G(FBLBL) D:X]"" ^DIWP S FBI=0 F S FBI=$O(@(FBNODE_","_FBI_")")) Q:'FBI S FBTXT=^(FBI,0),X=FBTXT D
  1. .I $Y+$S($G(FBCCI)>7&$G(FBCC):FBCCI,1:7)>IOSL W:'FBLET @IOF D:FBLET PAGE^FBUCLET1
  1. .D ^DIWP
  1. I $Y+$S($G(FBCCI)>7&$G(FBCC):FBCCI,1:7)>IOSL W:'FBLET @IOF D:FBLET PAGE^FBUCLET1
  1. D:$D(FBTXT) ^DIWW
  1. K FBLET Q
  1. PAGE ;write page
  1. W @IOF Q
  1. PDATE(FBDT) ;output fcn of date, long form
  1. ;INPUT: FBDT = date for output
  1. ;OUTPUT: month day, year
  1. N FBPDT,Y S Y=FBDT D PDATE^FBAAUTL Q $G(FBPDT)
  1. ;
  1. FBUC(X) ;unauthorized claim parameters
  1. ;INPUT: X = ien of parameter
  1. ;OUTPUT: "UC" node in parameter file
  1. Q $G(^FBAA(161.4,X,"UC"))
  1. ;
  1. DIE(DIE,DA,DR) ;update a field
  1. ;INPUT: DIE = global root
  1. ; DA = record to be updated
  1. ; DR = field to be updated
  1. ;OUTPUT: update record in file
  1. I $S($G(DIE)']"":1,$G(DR)']"":1,'+$G(DA):1,1:0) Q
  1. N FBLOCK
  1. D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -@(DIE_DA_")") K FBLOCK
  1. Q