AUTVDUP.m

AUTVDUP ; IHS/DIR/JDM/DFM - SEARCH FOR DUP EIN NUMBERS IN VENDOR FILE ; [ 06/28/1999  2:24 PM ]

 ;;98.1;IHS DICTIONARIES (POINTERS);**2**;MAR 04, 1998;Build 6

 ; IHS/ASDST/GTH AUT*98.1*2 - Y2K Fix, display 4-digit year.

 ;

 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." Q

 D HOME^%ZIS,DT^DICRW

 W !!,$$CTR("This report will generate a list of VENDORS whose",80),!,$$CTR("file contains either a DUPLICATE or MISSING EIN.",80)

DEVICE ;Device Selection

 W *7,!!,$$CTR("Since this report may take awhile to compile",80),!,$$CTR("it is recommended that you QUEUE to a PRINTER.",80)

 K DIR S %ZIS="PQ" W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" S DIR(0)="E" D ^DIR S IOP=$I D ^%ZIS G END:Y=0,DEVICE:Y=1

 I '$D(IO("Q")) G CALC

 ;

 S ZTRTN="CALC^AUTVDUP",ZTDESC="DUPLICATE EIN REPORT"

 D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS

END ; 

 K DIR,DTOUT,DIROUT,DUOUT,DIRUT,C,I,^TMP($J)

 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

 Q

CALC ;EP - From TaskMan 

 NEW AUTBAD,AUTDAT,AUTEIN,AUTPAGE,AUTSKIP,AUTTIM,AUTVNDR

 I '$D(ZTQUEUED),'$D(IO("S")) U IO(0) D WAIT^DICD U IO

 K ^TMP($J),E,V ; E is EIN, V is IEN

 S V=0

 F  S V=$O(^AUTTVNDR(V)) Q:'V  I $D(^AUTTVNDR(V,11)) S ^TMP($J,"DUP",$S($P(^AUTTVNDR(V,11),U):$P(^AUTTVNDR(V,11),U)_$P(^AUTTVNDR(V,11),U,2),1:"NOT ON FILE"),V)=""

 I '$D(^TMP($J,"DUP")) G PRINT

 S E=0

CHECK1 ; Check EIN.

 S E=$O(^TMP($J,"DUP",E))

 I E="" K E,V,^TMP($J,"DUP") G PRINT

 S V=""

VNDR ; Check vendor(s) with this EIN.

 S V=$O(^TMP($J,"DUP",E,V))

 G:V="" CHECK1

 I '$O(^TMP($J,"DUP",E,V)),'$D(^TMP($J,E)) K ^TMP($J,"DUP",E) G VNDR

 S ^TMP($J,E,V)=$S($D(^AUTTVNDR(V,0)):$P(^(0),U),1:"UNKNOWN")

 G VNDR

PRINT ; 

 S (AUTEIN,AUTPAGE,AUTSKIP)=0

 D NOW^%DTC,YX^%DTC S AUTDAT=$P(Y,"@",1),AUTTIM=$P(Y,"@",2)

 D HEADER,HDR S C=0

 I '$D(^TMP($J)) G END

P1 S AUTEIN=$O(^TMP($J,AUTEIN))

 G TOTL:'AUTEIN S AUTVNDR=""

 I AUTSKIP'=AUTEIN W !

P2 S AUTVNDR=$O(^TMP($J,AUTEIN,AUTVNDR))

 G:AUTVNDR="" P1

 W !,?12,AUTEIN,?30,$E($P(^TMP($J,AUTEIN,AUTVNDR),U),1,30) S C=C+1

 D LSTUSED(AUTVNDR)

 I IOST["P-"&($Y>(IOSL-10)) D HEADER,HDR

 I IOST["C-",'$D(IO("S"))&($Y>(IOSL-4)) K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0  D HEADER,HDR

 S AUTSKIP=AUTEIN

 G P2

TOTL W !!,?1,"TOTAL",?30,C

 I IOST["C-",'$D(IO("S")) K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0

BADEIN ; Print list of Vendors with no EIN on file

 S AUTPAGE=0

 D BADHEAD

 I '$D(^TMP($J,"NOT ON FILE")) W !!,"Good for YOU!! All VENDORS in your file have EIN's!" G END

 S %=0 F  S %=$O(^TMP($J,"NOT ON FILE",%)) Q:'$D(^AUTTVNDR(%))  S ^TMP($J,"NOT ON FILE",$P(^AUTTVNDR(%,0),U))="" K ^TMP($J,"NOT ON FILE",%)

 W !! S AUTBAD="",C=0

BAD1 S AUTBAD=$O(^TMP($J,"NOT ON FILE",AUTBAD))

 G BADTOTL:AUTBAD=""

 W !,?12,AUTBAD S C=C+1

 I IOST["P-"&($Y>(IOSL-10)) D BADHEAD

 I IOST["C-",'$D(IO("S"))&($Y>(IOSL-4)) K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0  D BADHEAD

 G BAD1

BADTOTL ; 

 W !!,?1,"TOTAL",?12,C

 I IOST["C-",'$D(IO("S")) K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0

 W @IOF

 G END

HEADER ;Prints heading

 S AUTPAGE=AUTPAGE+1

 W @IOF,!,"*",AUTDAT,$$CTR($$LOC,(80-(2*$X))),?80-$L(AUTTIM_"*"),AUTTIM,"*",!,"*User: ",$$USR,$$CTR("DUPLICATE VENDOR EIN - Page "_AUTPAGE,(80-(2*$X))),?80-$L("Device:"_IO_"*"),"Device:",IO,"*",!,$$DUP("*",80)

 Q

HDR ;

 W !!?12,"VENDOR EIN",?30,"VENDOR NAME",?66,"LAST USED CHS",!,$$DUP("~",80),!

 Q

 ;

BADHEAD ; Prints heading of missing EIN's

 D HEADER

 W !!,$$CTR("The following do(es) not have an EIN entry in the VENDOR FILE.",80),!,$$CTR("PLEASE validate and correct.",80),!,$$DUP("~",80),!

 Q

 ;

LSTUSED(V) ; Checks last used date in ^ACHSF(,"VB"

 NEW D,I,L ; I = IEN, L = Location, V = Vendor ien

 S L=0

 ; begin IHS/ASDST/GTH AUT*98.1*2 - Y2K Fix, display 4-digit year.

 ; F  S L=$O(^ACHSF(L)) Q:'L  S I=0 F  S I=$O(^ACHSF(L,"VB",V,I)) Q:'I  S D=I

 ; Q:'$D(D)

 ; S %=$P($G(^ACHSF(I,"D",D,0)),U,2)

 ; W ?65,$E(%,4,5),"-",$E(%,6,7),"-",$E(%,2,3)

 ;

 F  Q:'$O(^ACHSF(L))  S L=$O(^ACHSF(L))  S I=0 F  S I=$O(^ACHSF(L,"VB",V,I)) Q:'I  S D(L)=I

 Q:'$D(D)

 S %=0

 F  S %=$O(D(%)) Q:'%  S D(%)=$P($G(^ACHSF(%,"D",D(%),0)),U,2)

 S (%,D)=0

 F  S %=$O(D(%)) Q:'%  I D(%)>D S D=D(%)

 W ?66,$$FMTE^XLFDT(D,5)

 ; end IHS/ASDST/GTH AUT*98.1*2 - Y2K Fix, display 4-digit year.

 ;

 Q

 ;

LOC() Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

USR() Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

CTR(X,Y) ; Center X in field of length Y.       

 S %=$S($D(Y):Y,$D(IOM):IOM,1:80)

 Q $J("",%-$L(X)\2)_X

DUP(X,Y) ; Duplicate X for Y times.

 S %="",$P(%,X,Y+1)=""

 Q %

AUTVDUP   ; IHS/DIR/JDM/DFM - SEARCH FOR DUP EIN NUMBERS IN VENDOR FILE ; [ 06/28/1999  2:24 PM ]

 +1       ;;98.1;IHS DICTIONARIES (POINTERS);**2**;MAR 04, 1998;Build 6

 +2       ; IHS/ASDST/GTH AUT*98.1*2 - Y2K Fix, display 4-digit year.

 +3       ;

 +4        IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR 0."

               QUIT 

 +5        DO HOME^%ZIS

           DO DT^DICRW

 +6        WRITE !!,$$CTR("This report will generate a list of VENDORS whose",80),!,$$CTR("file contains either a DUPLICATE or MISSING EIN.",80)

DEVICE    ;Device Selection

 +1        WRITE *7,!!,$$CTR("Since this report may take awhile to compile",80),!,$$CTR("it is recommended that you QUEUE to a PRINTER.",80)

 +2        KILL DIR

           SET %ZIS="PQ"

           WRITE !

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED - REQUEST ABORTED"

               SET DIR(0)="E"

               DO ^DIR

               SET IOP=$IO

               DO ^%ZIS

               IF Y=0

                   GOTO END

               IF Y=1

                   GOTO DEVICE

 +3        IF '$DATA(IO("Q"))

               GOTO CALC

 +4       ;

 +5        SET ZTRTN="CALC^AUTVDUP"

           SET ZTDESC="DUPLICATE EIN REPORT"

 +6        DO ^%ZTLOAD

           KILL IO("Q"),ZTSK

           DO HOME^%ZIS

END       ; 

 +1        KILL DIR,DTOUT,DIROUT,DUOUT,DIRUT,C,I,^TMP($JOB)

 +2        DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT 

CALC      ;EP - From TaskMan 

 +1        NEW AUTBAD,AUTDAT,AUTEIN,AUTPAGE,AUTSKIP,AUTTIM,AUTVNDR

 +2        IF '$DATA(ZTQUEUED)

               IF '$DATA(IO("S"))

                   USE IO(0)

                   DO WAIT^DICD

                   USE IO

 +3       ; E is EIN, V is IEN

           KILL ^TMP($JOB),E,V

 +4        SET V=0

 +5        FOR 

               SET V=$ORDER(^AUTTVNDR(V))

               IF 'V

                   QUIT 

               IF $DATA(^AUTTVNDR(V,11))

                   SET ^TMP($JOB,"DUP",$SELECT($PIECE(^AUTTVNDR(V,11),U):$PIECE(^AUTTVNDR(V,11),U)_$PIECE(^AUTTVNDR(V,11),U,2),1:"NOT ON FILE"),V)=""

 +6        IF '$DATA(^TMP($JOB,"DUP"))

               GOTO PRINT

 +7        SET E=0

CHECK1    ; Check EIN.

 +1        SET E=$ORDER(^TMP($JOB,"DUP",E))

 +2        IF E=""

               KILL E,V,^TMP($JOB,"DUP")

               GOTO PRINT

 +3        SET V=""

VNDR      ; Check vendor(s) with this EIN.

 +1        SET V=$ORDER(^TMP($JOB,"DUP",E,V))

 +2        IF V=""

               GOTO CHECK1

 +3        IF '$ORDER(^TMP($JOB,"DUP",E,V))

               IF '$DATA(^TMP($JOB,E))

                   KILL ^TMP($JOB,"DUP",E)

                   GOTO VNDR

 +4        SET ^TMP($JOB,E,V)=$SELECT($DATA(^AUTTVNDR(V,0)):$PIECE(^(0),U),1:"UNKNOWN")

 +5        GOTO VNDR

PRINT     ; 

 +1        SET (AUTEIN,AUTPAGE,AUTSKIP)=0

 +2        DO NOW^%DTC

           DO YX^%DTC

           SET AUTDAT=$PIECE(Y,"@",1)

           SET AUTTIM=$PIECE(Y,"@",2)

 +3        DO HEADER

           DO HDR

           SET C=0

 +4        IF '$DATA(^TMP($JOB))

               GOTO END

P1         SET AUTEIN=$ORDER(^TMP($JOB,AUTEIN))

 +1        IF 'AUTEIN

               GOTO TOTL

           SET AUTVNDR=""

 +2        IF AUTSKIP'=AUTEIN

               WRITE !

P2         SET AUTVNDR=$ORDER(^TMP($JOB,AUTEIN,AUTVNDR))

 +1        IF AUTVNDR=""

               GOTO P1

 +2        WRITE !,?12,AUTEIN,?30,$EXTRACT($PIECE(^TMP($JOB,AUTEIN,AUTVNDR),U),1,30)

           SET C=C+1

 +3        DO LSTUSED(AUTVNDR)

 +4        IF IOST["P-"&($Y>(IOSL-10))

               DO HEADER

               DO HDR

 +5        IF IOST["C-"

               IF '$DATA(IO("S"))&($Y>(IOSL-4))

                   KILL DIR

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       QUIT 

                   DO HEADER

                   DO HDR

 +6        SET AUTSKIP=AUTEIN

 +7        GOTO P2

TOTL       WRITE !!,?1,"TOTAL",?30,C

 +1        IF IOST["C-"

               IF '$DATA(IO("S"))

                   KILL DIR

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       QUIT 

BADEIN    ; Print list of Vendors with no EIN on file

 +1        SET AUTPAGE=0

 +2        DO BADHEAD

 +3        IF '$DATA(^TMP($JOB,"NOT ON FILE"))

               WRITE !!,"Good for YOU!! All VENDORS in your file have EIN's!"

               GOTO END

 +4        SET %=0

           FOR 

               SET %=$ORDER(^TMP($JOB,"NOT ON FILE",%))

               IF '$DATA(^AUTTVNDR(%))

                   QUIT 

               SET ^TMP($JOB,"NOT ON FILE",$PIECE(^AUTTVNDR(%,0),U))=""

               KILL ^TMP($JOB,"NOT ON FILE",%)

 +5        WRITE !!

           SET AUTBAD=""

           SET C=0

BAD1       SET AUTBAD=$ORDER(^TMP($JOB,"NOT ON FILE",AUTBAD))

 +1        IF AUTBAD=""

               GOTO BADTOTL

 +2        WRITE !,?12,AUTBAD

           SET C=C+1

 +3        IF IOST["P-"&($Y>(IOSL-10))

               DO BADHEAD

 +4        IF IOST["C-"

               IF '$DATA(IO("S"))&($Y>(IOSL-4))

                   KILL DIR

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       QUIT 

                   DO BADHEAD

 +5        GOTO BAD1

BADTOTL   ; 

 +1        WRITE !!,?1,"TOTAL",?12,C

 +2        IF IOST["C-"

               IF '$DATA(IO("S"))

                   KILL DIR

                   SET DIR(0)="E"

                   WRITE !!

                   DO ^DIR

                   IF Y=0

                       QUIT 

 +3        WRITE @IOF

 +4        GOTO END

HEADER    ;Prints heading

 +1        SET AUTPAGE=AUTPAGE+1

 +2        WRITE @IOF,!,"*",AUTDAT,$$CTR($$LOC,(80-(2*$X))),?80-$LENGTH(AUTTIM_"*"),AUTTIM,"*",!,"*User: ",$$USR,$$CTR("DUPLICATE VENDOR EIN - Page "_AUTPAGE,(80-(2*$X))),?80-$LENGTH("Device:"_IO_"*"),"Device:",IO,"*",!,$$DUP("*",80)

 +3        QUIT 

HDR       ;

 +1        WRITE !!?12,"VENDOR EIN",?30,"VENDOR NAME",?66,"LAST USED CHS",!,$$DUP("~",80),!

 +2        QUIT 

 +3       ;

BADHEAD   ; Prints heading of missing EIN's

 +1        DO HEADER

 +2        WRITE !!,$$CTR("The following do(es) not have an EIN entry in the VENDOR FILE.",80),!,$$CTR("PLEASE validate and correct.",80),!,$$DUP("~",80),!

 +3        QUIT 

 +4       ;

LSTUSED(V) ; Checks last used date in ^ACHSF(,"VB"

 +1       ; I = IEN, L = Location, V = Vendor ien

           NEW D,I,L

 +2        SET L=0

 +3       ; begin IHS/ASDST/GTH AUT*98.1*2 - Y2K Fix, display 4-digit year.

 +4       ; F  S L=$O(^ACHSF(L)) Q:'L  S I=0 F  S I=$O(^ACHSF(L,"VB",V,I)) Q:'I  S D=I

 +5       ; Q:'$D(D)

 +6       ; S %=$P($G(^ACHSF(I,"D",D,0)),U,2)

 +7       ; W ?65,$E(%,4,5),"-",$E(%,6,7),"-",$E(%,2,3)

 +8       ;

 +9        FOR 

               IF '$ORDER(^ACHSF(L))

                   QUIT 

               SET L=$ORDER(^ACHSF(L))

               SET I=0

               FOR 

                   SET I=$ORDER(^ACHSF(L,"VB",V,I))

                   IF 'I

                       QUIT 

                   SET D(L)=I

 +10       IF '$DATA(D)

               QUIT 

 +11       SET %=0

 +12       FOR 

               SET %=$ORDER(D(%))

               IF '%

                   QUIT 

               SET D(%)=$PIECE($GET(^ACHSF(%,"D",D(%),0)),U,2)

 +13       SET (%,D)=0

 +14       FOR 

               SET %=$ORDER(D(%))

               IF '%

                   QUIT 

               IF D(%)>D

                   SET D=D(%)

 +15       WRITE ?66,$$FMTE^XLFDT(D,5)

 +16      ; end IHS/ASDST/GTH AUT*98.1*2 - Y2K Fix, display 4-digit year.

 +17      ;

 +18       QUIT 

 +19      ;

LOC()      QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

USR()      QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

CTR(X,Y)  ; Center X in field of length Y.       

 +1        SET %=$SELECT($DATA(Y):Y,$DATA(IOM):IOM,1:80)

 +2        QUIT $JUSTIFY("",%-$LENGTH(X)\2)_X

DUP(X,Y)  ; Duplicate X for Y times.

 +1        SET %=""

           SET $PIECE(%,X,Y+1)=""

 +2        QUIT %