ACGSPUTL ;IHS/OIRM/DSD/THL,AEF - PRINT UTILITY FOR VENDOR AND GEOGRAPHICAL LOCATION LISTINGS; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;PRINT UTILITY FOR VENDOR AND GEOGRAPHICAL LOCATION LISTINGS
EXIT K ACGQUIT,ACGION,ACGIOPAR,ACG,ACGI,ACGDATA,ACGDIC,ACGTYPE,ACGX,ACGY,BY,FR,TO,DIC,DA,DR
Q
VENDOR ;EP;TO PRINT VENDOR LISTINGS
S ACGTYPE="V"
I ACG4=236 G ZIS1
S ACGDIC="^AUTTVNDR(",ACGFLDS="[ACG CONTRACTOR LIST]",ACGX="CONTRACTOR LISTING",DIS(0)="I $D(^AUTTVNDR(D0,11)),$L($P(^(11),U,13)),$D(^ACGS(""M"",$P(^AUTTVNDR(D0,11),U,13)))"
S DIR(0)="SO^1:Print CIS Vendors Only;2:Print ALL Vendors",DIR("A")="Which one",DIR("B")=1
W !
D DIR^ACGSDIC
Q:$D(ACGQUIT)
I Y=1 S DIS(0)="I $D(^ACGS(""H"",D0))"
D HEAD,CHOICE,EXIT
Q
GL ;EP;TO PRINT GEOGRAPHICAL LOCATION LISTINGS
S ACGTYPE="G",ACGDIC="^AUTTGL(",ACGFLDS="[ACG GEOGRAPHICAL LOCATION]",ACGX="GEOGRAPHICAL LOCATION LISTING"
D HEAD,CHOICE,EXIT
Q
CHOICE D DISPLAY
S DIR(0)="LOA^1:"_(ACGI-1),DIR("A")="Which ONE(S): ",DIR("B")=1
W !
D DIR^ACGSDIC
I X=""!($E(X)=U) S ACGQUIT="" Q
S ACGSORT=Y
G:ACGTYPE="V1" LOOP
I ACGDIC["AUTTVNDR" D Q:$D(ACGQUIT)
.S DIR(0)="SO^1:CONTRACTOR SUMMARY;2:COMPLETE CONTRACTOR DATA",DIR("A")="Which REPORT",DIR("B")="1"
.D DIR^ACGSDIC
.Q:$D(ACGQUIT)
.S ACGFLDS=$S(+Y=1:ACGFLDS,1:"[ACG VENDOR DATA-VENDOR-2]")
LOOP S (BY,FR,TO)=""
F ACGI=1:1 S ACGX=$P(ACGSORT,",",ACGI) Q:'ACGX I $D(ACGDATA(ACGX)) S ACGDATA=ACGDATA(ACGX),BY=BY_$P(ACGDATA,U,3)_",",FR=FR_$S($P(ACGDATA,U,4)'="":$P(ACGDATA,U,4),1:","),TO=TO_$S($P(ACGDATA,U,5)'="":$P(ACGDATA,U,5),1:",")
F ACGX="BY","FR","TO" S:$E(@ACGX,$L(@ACGX))="," @ACGX=$E(@ACGX,1,($L(@ACGX)-1))
D ZIS
Q
DISPLAY W !!," Choose one or more sort criterion:",!
F ACGI=1:1 S ACGDATA=$T(@ACGTYPE+ACGI) Q:$P(ACGDATA,";;",2)="" S ACGDATA(ACGI)=$P(ACGDATA,";;",2) W !?10,$P(ACGDATA(ACGI),U),?20,$P(ACGDATA(ACGI),U,2)
Q
ZIS S DIC=ACGDIC,FLDS=ACGFLDS,DIOEND="D:$E(IOST,1,2)=""C-"" HOLD^ACGSMENU W:$D(IOF) @IOF",ZTRTN="PRINT^ACGSPUTL",ZTDESC="CIS "_$S(ACGTYPE="V":"VENDOR",1:"GEOGRAPHICAL LOCATION")_" REPORT"
ZIS1 I ACG4=236 S ZTRTN="V1^ACGSPUTL"
D ^ACGSZIS
Q:$D(ACGQUIT)
PRINT I ION["HOST",$D(ACGIOPAR) S %ZIS("IOPAR")=ACGIOPAR S:$D(ACGIO("HFSIO")) IO("HFSIO")=ACGIO("HFSIO")
S IOP=ACGION
I ACG4=236 D V1 Q
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,
V1 ;
I '$D(ZTQUEUED) S (ACGIOP,IOP)=ION D ^%ZIS I POP S ACGQUIT="" Q
U IO
D V11
S ACG=""
F S ACG=$O(^ACGS("O",ACG)) Q:ACG=""!$D(ACGQUIT) S ACGDA=0 F S ACGDA=$O(^ACGS("O",ACG,ACGDA)) Q:'ACGDA I $D(^ACGS(ACGDA,0)),$P(^(0),U)=0,$D(^("DT")) D
.S ACGDT=^ACGS(ACGDA,"DT")
.I $D(^ACGS(ACGDA,"IHS1")) S ACGIHS1=^("IHS1"),ACGCC=+ACGIHS1,ACGSC=$P(ACGIHS1,U,2) S ACGCC=$S(ACGCC:$P(^ACGCC(ACGCC,0),U),1:"--"),ACGSC=$S(ACGSC:$P(^ACGSC(ACGSC,0),U),1:"--"),ACGENT=ACGCC_ACGSC
.E S ACGENT="----"
.W !,$P(ACGDT,U,11),?14,$P(ACGDT,U,5),?50,$P(ACGDT,U,10),?$X+1,ACGENT,?$X+1,$E($P(ACGDT,U,2),1,9),!?14,$P(ACGDT,U,6),?50,$E($P(ACGDT,U,7),1,15)
.I $P(ACGDT,U,8) W ?69,$P(^DIC(5,$P(ACGDT,U,8),0),U,2),?$X+1,$P(ACGDT,U,9),?$X+1,$P(^DIC(5,$P(ACGDT,U,8),0),U,3)
.I $Y>(IOSL-4) D:$E(IOST,1,2)="C-" HOLD^ACGSMENU D V11
Q
V11 W:$D(IOF) @IOF W !?20,"IHS CIS CONTRACTOR LISTING",!,"===============================================================================",!
Q
;
G ;;
;;1^LOCATION NAME^.01^^
;;2^COUNTY^#.05^^
;;3^STATE^#.06^^
;;4^LABOR SUPLUS AREA^.07^2^2
;;
HEAD D HEAD^ACGSMENU
W !!?80-$L(ACGX)\2,ACGX K ACGX
Q
DIR D ^DIR S:$D(DIRUT) ACGQUIT="" K DIR,DIRUT,DUOUT,DTOUT Q
ACGSPUTL ;IHS/OIRM/DSD/THL,AEF - PRINT UTILITY FOR VENDOR AND GEOGRAPHICAL LOCATION LISTINGS; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;PRINT UTILITY FOR VENDOR AND GEOGRAPHICAL LOCATION LISTINGS
EXIT KILL ACGQUIT,ACGION,ACGIOPAR,ACG,ACGI,ACGDATA,ACGDIC,ACGTYPE,ACGX,ACGY,BY,FR,TO,DIC,DA,DR
+1 QUIT
VENDOR ;EP;TO PRINT VENDOR LISTINGS
+1 SET ACGTYPE="V"
+2 IF ACG4=236
GOTO ZIS1
+3 SET ACGDIC="^AUTTVNDR("
SET ACGFLDS="[ACG CONTRACTOR LIST]"
SET ACGX="CONTRACTOR LISTING"
SET DIS(0)="I $D(^AUTTVNDR(D0,11)),$L($P(^(11),U,13)),$D(^ACGS(""M"",$P(^AUTTVNDR(D0,11),U,13)))"
+4 SET DIR(0)="SO^1:Print CIS Vendors Only;2:Print ALL Vendors"
SET DIR("A")="Which one"
SET DIR("B")=1
+5 WRITE !
+6 DO DIR^ACGSDIC
+7 IF $DATA(ACGQUIT)
QUIT
+8 IF Y=1
SET DIS(0)="I $D(^ACGS(""H"",D0))"
+9 DO HEAD
DO CHOICE
DO EXIT
+10 QUIT
GL ;EP;TO PRINT GEOGRAPHICAL LOCATION LISTINGS
+1 SET ACGTYPE="G"
SET ACGDIC="^AUTTGL("
SET ACGFLDS="[ACG GEOGRAPHICAL LOCATION]"
SET ACGX="GEOGRAPHICAL LOCATION LISTING"
+2 DO HEAD
DO CHOICE
DO EXIT
+3 QUIT
CHOICE DO DISPLAY
+1 SET DIR(0)="LOA^1:"_(ACGI-1)
SET DIR("A")="Which ONE(S): "
SET DIR("B")=1
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF X=""!($EXTRACT(X)=U)
SET ACGQUIT=""
QUIT
+5 SET ACGSORT=Y
+6 IF ACGTYPE="V1"
GOTO LOOP
+7 IF ACGDIC["AUTTVNDR"
Begin DoDot:1
+8 SET DIR(0)="SO^1:CONTRACTOR SUMMARY;2:COMPLETE CONTRACTOR DATA"
SET DIR("A")="Which REPORT"
SET DIR("B")="1"
+9 DO DIR^ACGSDIC
+10 IF $DATA(ACGQUIT)
QUIT
+11 SET ACGFLDS=$SELECT(+Y=1:ACGFLDS,1:"[ACG VENDOR DATA-VENDOR-2]")
End DoDot:1
IF $DATA(ACGQUIT)
QUIT
LOOP SET (BY,FR,TO)=""
+1 FOR ACGI=1:1
SET ACGX=$PIECE(ACGSORT,",",ACGI)
IF 'ACGX
QUIT
IF $DATA(ACGDATA(ACGX))
SET ACGDATA=ACGDATA(ACGX)
SET BY=BY_$PIECE(ACGDATA,U,3)_","
SET FR=FR_$SELECT($PIECE(ACGDATA,U,4)'="":$PIECE(ACGDATA,U,4),1:",")
SET TO=TO_$SELECT($PIECE(ACGDATA,U,5)'="":$PIECE(ACGDATA,U,5),1:",")
+2 FOR ACGX="BY","FR","TO"
IF $EXTRACT(@ACGX,$LENGTH(@ACGX))=","
SET @ACGX=$EXTRACT(@ACGX,1,($LENGTH(@ACGX)-1))
+3 DO ZIS
+4 QUIT
DISPLAY WRITE !!," Choose one or more sort criterion:",!
+1 FOR ACGI=1:1
SET ACGDATA=$TEXT(@ACGTYPE+ACGI)
IF $PIECE(ACGDATA,";;",2)=""
QUIT
SET ACGDATA(ACGI)=$PIECE(ACGDATA,";;",2)
WRITE !?10,$PIECE(ACGDATA(ACGI),U),?20,$PIECE(ACGDATA(ACGI),U,2)
+2 QUIT
ZIS SET DIC=ACGDIC
SET FLDS=ACGFLDS
SET DIOEND="D:$E(IOST,1,2)=""C-"" HOLD^ACGSMENU W:$D(IOF) @IOF"
SET ZTRTN="PRINT^ACGSPUTL"
SET ZTDESC="CIS "_$SELECT(ACGTYPE="V":"VENDOR",1:"GEOGRAPHICAL LOCATION")_" REPORT"
ZIS1 IF ACG4=236
SET ZTRTN="V1^ACGSPUTL"
+1 DO ^ACGSZIS
+2 IF $DATA(ACGQUIT)
QUIT
PRINT IF ION["HOST"
IF $DATA(ACGIOPAR)
SET %ZIS("IOPAR")=ACGIOPAR
IF $DATA(ACGIO("HFSIO"))
SET IO("HFSIO")=ACGIO("HFSIO")
+1 SET IOP=ACGION
+2 IF ACG4=236
DO V1
QUIT
+3 DO EN1^DIP
+4 KILL IOP
+5 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,
V1 ;
+1 IF '$DATA(ZTQUEUED)
SET (ACGIOP,IOP)=ION
DO ^%ZIS
IF POP
SET ACGQUIT=""
QUIT
+2 USE IO
+3 DO V11
+4 SET ACG=""
+5 FOR
SET ACG=$ORDER(^ACGS("O",ACG))
IF ACG=""!$DATA(ACGQUIT)
QUIT
SET ACGDA=0
FOR
SET ACGDA=$ORDER(^ACGS("O",ACG,ACGDA))
IF 'ACGDA
QUIT
IF $DATA(^ACGS(ACGDA,0))
IF $PIECE(^(0),U)=0
IF $DATA(^("DT"))
Begin DoDot:1
+6 SET ACGDT=^ACGS(ACGDA,"DT")
+7 IF $DATA(^ACGS(ACGDA,"IHS1"))
SET ACGIHS1=^("IHS1")
SET ACGCC=+ACGIHS1
SET ACGSC=$PIECE(ACGIHS1,U,2)
SET ACGCC=$SELECT(ACGCC:$PIECE(^ACGCC(ACGCC,0),U),1:"--")
SET ACGSC=$SELECT(ACGSC:$PIECE(^ACGSC(ACGSC,0),U),1:"--")
SET ACGENT=ACGCC_ACGSC
+8 IF '$TEST
SET ACGENT="----"
+9 WRITE !,$PIECE(ACGDT,U,11),?14,$PIECE(ACGDT,U,5),?50,$PIECE(ACGDT,U,10),?$X+1,ACGENT,?$X+1,$EXTRACT($PIECE(ACGDT,U,2),1,9),!?14,$PIECE(ACGDT,U,6),?50,$EXTRACT($PIECE(ACGDT,U,7),1,15)
+10 IF $PIECE(ACGDT,U,8)
WRITE ?69,$PIECE(^DIC(5,$PIECE(ACGDT,U,8),0),U,2),?$X+1,$PIECE(ACGDT,U,9),?$X+1,$PIECE(^DIC(5,$PIECE(ACGDT,U,8),0),U,3)
+11 IF $Y>(IOSL-4)
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
DO V11
End DoDot:1
+12 QUIT
V11 IF $DATA(IOF)
WRITE @IOF
WRITE !?20,"IHS CIS CONTRACTOR LISTING",!,"===============================================================================",!
+1 QUIT
+2 ;
G ;;
+1 ;;1^LOCATION NAME^.01^^
+2 ;;2^COUNTY^#.05^^
+3 ;;3^STATE^#.06^^
+4 ;;4^LABOR SUPLUS AREA^.07^2^2
+5 ;;
HEAD DO HEAD^ACGSMENU
+1 WRITE !!?80-$LENGTH(ACGX)\2,ACGX
KILL ACGX
+2 QUIT
DIR DO ^DIR
IF $DATA(DIRUT)
SET ACGQUIT=""
KILL DIR,DIRUT,DUOUT,DTOUT
QUIT
