- 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 ;;