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