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

ACRFPUTL.m

Go to the documentation of this file.
  1. ACRFPUTL ;IHS/OIRM/DSD/THL,AEF - PRINT VENDOR DATA; [ 09/06/2006 9:44 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
  1. ;;ROUTINE TO PRINT VENDOR DATA
  1. EXIT K ACRQUIT,ACR,ACRI,ACRDATA,ACRDIC,ACRTYPE,ACRX,ACRY,BY,FR,TO,DIC,DA,DR,FLDS,ACRBY,ACRFR,ACRTO
  1. Q
  1. VENDOR ;EP;TO PRINT VENDOR LISTINGS
  1. S ACRTYPE="V"
  1. S ACRDIC="^AUTTVNDR("
  1. S ACRFLDS="[ACR CONTRACTOR LIST]"
  1. S ACRX="CONTRACTOR LISTING"
  1. S DIR(0)="SO^1:Print ARMS Vendors Only;2:Print ALL Vendors"
  1. S DIR("A")="Which one"
  1. S DIR("B")=1
  1. W !
  1. D DIR^ACRFDIC
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. I Y=1 S DIS(0)="I $D(^ACRDOC(""I"",D0))"
  1. D CHOICE,EXIT
  1. Q
  1. CHOICE D DISPLAY
  1. S DIR(0)="LOA^1:"_(ACRI-1)
  1. S DIR("A")="Which ONE(S): "
  1. S DIR("B")=1
  1. W !
  1. D DIR^ACRFDIC
  1. I X=""!($E(X)=U) S ACRQUIT="" Q
  1. S ACRX=$E(Y,1,($L(Y)-1))
  1. G:ACRTYPE="V1" LOOP
  1. S DIR(0)="SO^1:CONTRACTOR SUMMARY;2:COMPLETE CONTRACTOR DATA"
  1. S DIR("A")="Which REPORT"
  1. S DIR("B")="1"
  1. D DIR^ACRFDIC
  1. Q:$D(ACRQUIT)!$D(ACROUT)
  1. S ACRFLDS=$S(+Y=1:ACRFLDS,1:"[ACR VENDOR DATA-VENDOR-2]")
  1. LOOP S (BY,FR,TO)=""
  1. F ACRI=1:1:$L(ACRX,",") D
  1. .S ACRDATA=ACRDATA($P(ACRX,",",ACRI))
  1. .S BY=BY_$P(ACRDATA,U,3)_","
  1. .S FR=FR_$S($P(ACRDATA,U,4)]"":$P(ACRDATA,U,4),1:",")
  1. .S TO=TO_$S($P(ACRDATA,U,5)]"":$P(ACRDATA,U,5),1:",")
  1. F ACRX="BY","FR","TO" D
  1. .S:$E(@ACRX,$L(@ACRX))="," @ACRX=$E(@ACRX,1,($L(@ACRX)-1))
  1. S ACRBY=BY
  1. S ACRFR=FR
  1. S ACRTO=TO
  1. D ZIS
  1. Q
  1. DISPLAY W !!," Choose one or more sort criterion:"
  1. W !
  1. F ACRI=1:1 Q:$D(ACRQUIT) D
  1. .S ACRDATA=$T(@ACRTYPE+ACRI)
  1. .I $P(ACRDATA,";;",2)="" S ACRQUIT="" Q
  1. .S ACRDATA(ACRI)=$P(ACRDATA,";;",2)
  1. .W !?10,$P(ACRDATA(ACRI),U)
  1. .W ?20,$P(ACRDATA(ACRI),U,2)
  1. K ACRQUIT
  1. Q
  1. ZIS S ACRRTN="PRINT^ACRFPUTL"
  1. S ZTDESC="ARMS VENDOR"
  1. ZIS1 D ^ACRFZIS
  1. Q
  1. PRINT S IOP=ION
  1. S DIC=ACRDIC
  1. S FLDS=ACRFLDS
  1. S DIOEND="D:$E(IOST,1,2)=""C-"" PAUSE^ACRFWARN W @IOF"
  1. S BY=ACRBY
  1. S FR=ACRFR
  1. S TO=ACRTO
  1. S DIS(0)="I $P($G(^AUTTVNDR(D0,0)),U,5)=""""" ;ACR*2.1*20.14
  1. D EN1^DIP
  1. K IOP
  1. Q
  1. V ;;
  1. ;;1^VENDOR NAME^.01;S2^^
  1. ;;2^EIN^1101;S2^^
  1. ;;3^WOMEN OWNED^1115,.01;S2^1,^1,
  1. ;;4^638 CONTRACTORS^1126,.01;S2^D4,^D4,
  1. ;;5^BUY INDIAN^1128,.01;S2^6,^6,
  1. V1 ;
  1. D V11
  1. S ACR=""
  1. F S ACR=$O(^ACRF("O",ACR)) Q:ACR=""!$D(ACRQUIT)!$D(ACROUT) D
  1. .S ACRDA=0
  1. .F S ACRDA=$O(^ACRF("O",ACR,ACRDA)) Q:'ACRDA D
  1. ..Q:'$D(^ACRF(ACRDA,0))!($P($G(^(0)),U)=0)!'$D(^ACRF(ACRDA,"DT"))
  1. ..S ACRDT=^ACRF(ACRDA,"DT")
  1. ..I $D(^ACRF(ACRDA,"IHS1")) D I 1
  1. ...S ACRIHS1=^ACRF(ACRDA,"IHS1")
  1. ...S ACRCC=+ACRIHS1
  1. ...S ACRFC=$P(ACRIHS1,U,2)
  1. ...S ACRCC=$S(ACRCC:$P(^ACRCC(ACRCC,0),U),1:"--")
  1. ...S ACRFC=$S(ACRFC:$P(^ACRFC(ACRFC,0),U),1:"--")
  1. ...S ACRENT=ACRCC_ACRFC
  1. ..E S ACRENT="----"
  1. ..W !,$P(ACRDT,U,11)
  1. ..W ?14,$P(ACRDT,U,5)
  1. ..W ?50,$P(ACRDT,U,10)
  1. ..W ?$X+1,ACRENT
  1. ..W ?$X+1,$E($P(ACRDT,U,2),1,9)
  1. ..W !?14,$P(ACRDT,U,6)
  1. ..W ?50,$E($P(ACRDT,U,7),1,15)
  1. ..I $P(ACRDT,U,8) D
  1. ...W ?69,$P(^DIC(5,$P(ACRDT,U,8),0),U,2)
  1. ...W ?$X+1,$P(ACRDT,U,9)
  1. ...W ?$X+1,$P(^DIC(5,$P(ACRDT,U,8),0),U,3)
  1. ..I $Y>(IOSL-4) D
  1. ...D PAUSE^ACRFWARN:$E(IOST,1,2)="C-"
  1. ...D V11
  1. Q
  1. V11 W @IOF W !?20,"IHS ARMS CONTRACTOR LISTING"
  1. W !,"==============================================================================="
  1. W !
  1. Q
  1. ;
  1. G ;;
  1. ;;1^LOCATION NAME^.01^^
  1. ;;2^COUNTY^#.05^^
  1. ;;3^STATE^#.06^^
  1. ;;4^LABOR SUPLUS AREA^.07^2^2
  1. ;;