- 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
