Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AFSLDRVE

AFSLDRVE.m

Go to the documentation of this file. 
  1. AFSLDRVE ;IHS/OIRM/DSD/JDM - PRINT DUPLICATE VENDORS BY EIN.   [ 09/26/2005  12:53 PM ]
  1.  ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
  1.  ;Print duplicate vendors by EIN - part 2
  1.  ;K ^AFSLCTMP ; KILL OF SCRATCH WORK GLOBAL  ;ACR*2.1*19.05 IM16848
  1.  N ACRTMP                                    ;ACR*2.1*19.05 IM16848
  1.  S ACRTMP="^AFSLCTMP"                        ;ACR*2.1*19.05 IM16848
  1.  K @ACRTMP                                   ;ACR*2.1*19.05 IM16848
  1.  ;S AFSLUSR=$P(^VA(200,DUZ,0),U,1),AFSLFAC=$P(^AUTTLOC(DUZ(2),0),U,2)     ;ACR*2.1*19.02 IM16848
  1.  S AFSLUSR=$$NAME2^ACRFUTL1(DUZ)        ;ACR*2.1*19.02 IM16848
  1.  S AFSLFAC=$P(^AUTTLOC(DUZ(2),0),U,2)   ;ACR*2.1*19.02 IM16848
  1.  W !!?18,"This report will generate a list of VENDORS whose" W !?18,"file contains either a DUPLICATE or MISSING EIN."
  1. DIR ;
  1. DEVICE ;Device Selection
  1.  W *7,!!?18,"Since this report may take awhile to compile" W !?18,"it is recommended that you QUEUE to a PRINTER." S AFSLIOQ=""
  1.  ;K DIR S %ZIS="PQ" W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED - REQUEST ABORTED" S DIR(0)="E" U IO(0) D ^DIR S IOP=$I D ^%ZIS G END:Y=0,DEVICE:Y=1  ;ACR*2.1*19.05 IM16848
  1.  K DIR S %ZIS="PQ" W ! D ^%ZIS                  ;ACR*2.1*19.05 IM16848
  1.  I POP D  G END:Y=0,DEVICE:Y=1                  ;ACR*2.1*19.05 IM16848
  1.  .W !,"NO DEVICE SELECTED - REQUEST ABORTED"    ;ACR*2.1*19.05 IM16848
  1.  .S DIR(0)="E" U IO(0) D ^DIR                   ;ACR*2.1*19.05 IM16848
  1.  .D ^%ZIS                                       ;ACR*2.1*19.05 IM16848
  1.  S AFSLIO=IO I $D(IO("Q"))=1 S AFSLIOQ=IO("Q")
  1.  I AFSLIOQ="" W ! D WAIT^DICD G CALC
  1.  I $D(IO("S"))!($E(IOST)'="P") G DEVICE
  1. ZTLOAD ;Loads Taskman
  1.  S ZTRTN="CALC^AFSLDRVE",ZTIO="",ZTDESC="COMPILE DUPLICATE EIN REPORT"
  1.  F AFSLSAVE="AFSLFAC(","AFSLIO","AFSLUSR","AFSLIOQ","AFSLFACP" S ZTSAVE(AFSLSAVE)=""
  1.  ;D ^%ZTLOAD K IO("Q") S IOP=$I D HOME^%ZIS K IOP  ;ACR*2.1*19.05 IM16848
  1.  D ^%ZTLOAD K IO("Q") D HOME^%ZIS K IOP            ;ACR*2.1*19.05 IM16848
  1. END K AFSLUSR,DIR,DTOUT,DIROUT,DUOUT,DIRUT,AFSLFAC,AFSLBAD,AFSLVNDR,AFSLEIN,AFSLDAT,AFSLIO,AFSLIOQ,AFSLPAGE,AFSLSAVE,AFSLSKIP,AFSLTIM,C,I,POP,X,Y Q
  1. CALC ;S AFSLVNDR=0 K ^AFSLCTMP ; KILL OF SCRATCH WORK GLOBAL  ;ACR*2.1*19.05 IM16848
  1.  S AFSLVNDR=0                                      ;ACR*2.1*19.05 IM16848
  1.  N ACRTMP                                          ;ACR*2.1*19.05 IM16848
  1.  S ACRTMP="^AFSLCTMP"                              ;ACR*2.1*19.05 IM16848
  1.  K @ACRTMP                                         ;ACR*2.1*19.05 IM16848
  1. B S AFSLVNDR=$O(^AUTTVNDR(AFSLVNDR)) I 'AFSLVNDR S AFSLEIN=0 G CHECK
  1.  I '$D(^AUTTVNDR(AFSLVNDR,11)) G B
  1.  S AFSLEIN=$S($P(^AUTTVNDR(AFSLVNDR,11),U,1):$P(^AUTTVNDR(AFSLVNDR,11),U,1)_$P(^AUTTVNDR(AFSLVNDR,11),U,2),1:"NOT ON FILE")
  1.  S ^AFSLCTMP("DUP",AFSLEIN,AFSLVNDR)=""
  1.  I '$D(^AUTTVNDR(AFSLVNDR,13)) S AFSLADRN="^^^"
  1.  I $D(^AUTTVNDR(AFSLVNDR,13)) S AFSLADRN=^AUTTVNDR(AFSLVNDR,13)
  1.  G B
  1. CHECK S AFSLEIN=$O(^AFSLCTMP("DUP",AFSLEIN)) G:AFSLEIN="" ZTLOAD1 S AFSLVNDR=""
  1. VNDR S AFSLVNDR=$O(^AFSLCTMP("DUP",AFSLEIN,AFSLVNDR)) G:AFSLVNDR="" CHECK
  1.  I '$O(^AFSLCTMP("DUP",AFSLEIN,AFSLVNDR)),'$D(^AFSLCTMP(AFSLEIN)) K ^AFSLCTMP("DUP",AFSLEIN) G VNDR
  1.  S X="UNKNOWN" S:$D(^AUTTVNDR(AFSLVNDR,0)) X=$P(^(0),U,1)
  1.  S AFSLADRN="^^^"
  1.  I $D(^AUTTVNDR(AFSLVNDR,13)) S AFSLADRN=^AUTTVNDR(AFSLVNDR,13)
  1.  S ^AFSLCTMP(AFSLEIN,AFSLVNDR)=X_"^"_AFSLADRN
  1.  K ^AFSLCTMP("DUP",AFSLEIN,AFSLVNDR) G VNDR
  1. ZTLOAD1 ;Loads Taskman
  1.  I AFSLIOQ="" G PRINT
  1.  S ZTRTN="PRINT^AFSLDRVE",ZTDESC="PRINT DUPLICATE EIN REPORT",ZTIO=AFSLIO,ZTSAVE("AFSLIO")="",ZTSAVE("AFSLIOQ")="",ZTSAVE("AFSLUSR")="",ZTSAVE("^AFSLCTMP(")="",ZTSAVE("AFSLFACP")=""
  1.  K IOP
  1.  ;D ^%ZTLOAD K IO("Q") S IOP=$I D HOME^%ZIS K IOP  ;ACR*2.1*19.05 IM16848
  1.  D ^%ZTLOAD K IO("Q") D HOME^%ZIS K IOP            ;ACR*2.1*19.05 IM16848
  1.  Q
  1. PRINT S (AFSLEIN,AFSLPAGE,AFSLSKIP)=0 D HEADER S C=0
  1. P1 S AFSLEIN=$O(^AFSLCTMP(AFSLEIN)) G TOTL:'AFSLEIN S AFSLVNDR="" I AFSLSKIP'=AFSLEIN W !
  1. P2 S AFSLVNDR=$O(^AFSLCTMP(AFSLEIN,AFSLVNDR)) G:AFSLVNDR="" P1
  1.  S AFSLSTE=$P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,4)
  1.  I $P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,4)="" S AFSLSTAT=""
  1.  I $P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,4)'="" S AFSLSTAT=$P(^DIC(5,AFSLSTE,0),U,2)
  1.  W !?1,AFSLEIN,?16,$E($P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,1),1,30) S C=C+1 W ?63,$P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,2),?96,$P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,3),?116,AFSLSTAT,?120,$P(^AFSLCTMP(AFSLEIN,AFSLVNDR),U,5)
  1.  D LSTUSED
  1.  I IOST["P-"&($Y>56) D HEADER
  1.  I IOST["C-"&($Y>24) K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0  D HEADER
  1.  S AFSLSKIP=AFSLEIN G P2
  1. TOTL W !!?1,"TOTAL",?30,C
  1.  K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0
  1. BADEIN ;PRINTS LIST OF VENDORS WITH NO EIN ON FILE
  1.  S AFSLPAGE=0 D BADHEAD
  1.  W !! S AFSLBAD="",C=0
  1. BAD1 S AFSLBAD=$O(^AFSLCTMP("NOT ON FILE",AFSLBAD)) G BADTOTL:AFSLBAD=""
  1.  W !?12,$P(^AUTTVNDR(AFSLBAD,0),U,1) S C=C+1
  1.  I IOST["P-"&($Y>56) D BADHEAD
  1.  I IOST["C-"&($Y>24) K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0  D BADHEAD
  1.  G BAD1
  1. BADTOTL W !!?1,"TOTAL",?12,C
  1.  K DIR S DIR(0)="E" W !! D ^DIR Q:Y=0
  1.  Q
  1.  U IO W @IOF S AFSLPAGE=AFSLPAGE+1
  1.  D NOW^%DTC,YX^%DTC S AFSLDAT=$P(Y,"@",1),AFSLTIM=$P(Y,"@",2)
  1.  W !,"*",AFSLDAT S X=$P(^DIC(4,DUZ(2),0),U,1) W ?((80/2)-($L(X)/2)),X
  1.  ;W ?71,AFSLTIM,"*",!,"*User: ",AFSLUSR,?70,"Device:",$J(AFSLIO,2),"*"
  1.  W !! S X="DUPLICATE VENDOR EIN Report - Page " W ?((80/2)-($L(X)/2)),X_AFSLPAGE
  1.  ;W !! S X="For "_$P(^AUTTLOC(AFSLFACP,0),U,2) W ?((80/2)-($L(X)/2)),X
  1.  W !! F I=1:1:80 W "*"
  1.  W !!?12,"VENDOR EIN",?30,"VENDOR NAME",?66,"LAST USED"
  1.  W ! F I=1:1:80 W "~"
  1.  W !
  1.  Q
  1. BADHEAD ;Prints heading of missing EIN's
  1.  W @IOF S AFSLPAGE=AFSLPAGE+1
  1.  D NOW^%DTC,YX^%DTC S AFSLDAT=$P(Y,"@",1),AFSLTIM=$P(Y,"@",2)
  1.  W !,"*",AFSLDAT S X=$P(^DIC(4,DUZ(2),0),U,1) W ?((80/2)-($L(X)/2)),X
  1.  W ?71,AFSLTIM,"*",!,"*User: ",AFSLUSR,?70,"Device:",$J(AFSLIO,2),"*"
  1.  W !! S X="VENDOR(s) MISSING EIN Report - Page " W ?((80/2)-($L(X)/2)),X_AFSLPAGE
  1.  ;W !! S X="For "_$P(^AUTTLOC(AFSLFACP,0),U,2) W ?((80/2)-($L(X)/2)),X
  1.  W !! F I=1:1:80 W "*"
  1.  W !!?8,"The following do(es) not have an EIN entry in the VENDOR FILE." W !?25,"PLEASE validate and correct."
  1.  W ! F I=1:1:80 W "~"
  1.  W !
  1.  Q
  1. LSTUSED ;CHECKS LAST USED DATE IN ^AFSLF(DUZ(2),"VB"
  1.  S AFSLNODE=0
  1.  Q:'$D(^AFSLF(DUZ(2),"VB",AFSLVNDR))
  1. LST2 S AFSLNODE=$O(^AFSLF(DUZ(2),"VB",AFSLVNDR,AFSLNODE)) G LSTEND:+AFSLNODE=0
  1.  S AFSLDTSV=AFSLNODE
  1.  G LST2
  1. LSTEND S AFSLLUDT="" S:$D(AFSLDTSV) AFSLLUDT=$P(^AFSLF(DUZ(2),"D",AFSLDTSV,0),U,2)
  1.  W ?65,$E(AFSLLUDT,4,5),"-",$E(AFSLLUDT,6,7),"-",$E(AFSLLUDT,2,3)
  1.  Q