43 lines
2.8 KiB
Mathematica
43 lines
2.8 KiB
Mathematica
PRCFUOM ;WISC/SJG/PL-850 UNDELIVERED ORDERS RECONCILIATION ; 11/6/97 1510
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
BEG ;
|
|
S DIR(0)="Y",DIR("A")="Are you sure that you want to manually run this option"
|
|
S DIR("A",1)=" ",DIR("A",2)="This option generates the 850 Undelivered Orders Reconciliation Report."
|
|
S DIR("A",3)="This report is very resource intensive and should be scheduled to run"
|
|
S DIR("A",4)="in off-hours.",DIR("A",5)=" "
|
|
S DIR("A",6)="This report is restricted to purchase orders from a single station, and"
|
|
S DIR("A",7)="can be limited to a date range. The default date range is from T-90 days",DIR("A",8)="to T.",DIR("A",9)=" "
|
|
S DIR("T")=120,DIR("B")="NO" D ^DIR K DIR G:'Y!($D(DIRUT)) EXIT
|
|
SITE S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT S PRCFSITE=PRC("SITE") W !
|
|
DATE K PRCFBEG,PRCFBEGX,PRCFEND,PRCFENDX
|
|
S X="T-90" D ^%DT S PRCFBEG=Y,PRCFBEGZ=Y D DD^%DT S PRCFBEGX=Y
|
|
S X="T" D ^%DT S PRCFEND=Y D DD^%DT S PRCFENDX=Y
|
|
S %DT="AE",%DT("A")="Select BEGINNING DATE: ",%DT("B")=PRCFBEGX D ^%DT K %DT G:Y<1 EXIT
|
|
I Y>PRCFEND W !!,$C(7),"Beginning date can't be greater than Today's date. Please reenter !",! G DATE
|
|
I Y'=PRCFBEG S PRCFBEG=Y,PRCFBEGZ=Y D DD^%DT S PRCFBEGX=Y
|
|
W ! S %DT="AE",%DT("A")="Select ENDING DATE: ",%DT("B")=PRCFENDX D ^%DT K %DT G:Y<1 EXIT
|
|
I Y<PRCFBEGZ W !!,$C(7),"Ending date can't be less than Beginning date. Please reenter !",! G DATE
|
|
I Y>PRCFEND W !!,$C(7),"Ending date can't be greater than Today's date. Please reenter !",! G DATE
|
|
I Y'=PRCFEND S PRCFEND=Y D DD^%DT S PRCFENDX=Y
|
|
RPT D DEV G:POP EXIT I '$D(IO("Q")) D WAIT^DICD
|
|
I $D(IO("Q")) S ZTDTH="",ZTDESC="Running 850 Undelivered Orders Reconciliation Report",ZTRTN="DQ^PRCFUOM",ZTSAVE("PRC*")="" D ^%ZTLOAD,^%ZISC,AGN G EXIT:%'=1 W !! G SITE
|
|
D DQ,^%ZISC,AGN G EXIT:%'=1 W !! G SITE
|
|
DQ ;
|
|
S (PRCFAT,PRCFCT,PRCFOT,PRCFCS,PRCFOS,PRCFAS)=0,L=0
|
|
S DIC="^PRC(442,",FLDS="[PRCFUO]",BY="[PRCFUO MAN]" S:$D(ION) IOP=ION
|
|
S FR=",,"_PRCFBEG,TO=",,"_PRCFEND,DIOEND="D B^PRCFUO"
|
|
S PRCFI=";30;31;33;37;38;40;41;45;48;49;",PRCFMOP=";1;8;"
|
|
S DIS(0)="I $D(^PRC(442,D0,0)),$O(^PRC(442,D0,22,0))>0 I $P(^PRC(442,D0,0),U,17)'=$P(^(0),U,16) I +$P(^(0),U,1)=PRCFSITE I $G(^PRC(442,D0,7)),PRCFI'[("";""_$P($G(^PRC(442,D0,7)),""^"",2)_"";"")"
|
|
S DIS(1)="I $D(^PRC(442,D0,0)),$P(^(0),U,2),PRCFMOP[("";""_$P(^(0),U,2)_"";"") D C^PRCFUO I PRCFU>.01"
|
|
S DHD="850 UNDELIVERED ORDERS RECONCILIATION FOR STATION "_PRCFSITE_" FROM "_PRCFBEGX_" TO "_PRCFENDX
|
|
D EN1^DIP,EXIT
|
|
Q
|
|
EXIT ;
|
|
KILL %,%DT,%ZIS,BY,DHD,DIC,DIOEND,DIR,DIRUT,DIS,FLDS,FR,L,PRC
|
|
KILL PRCF,PRCFAS,PRCFAT,PRCFBEG,PRCFBEGX,PRCFBEGZ,PRCFCS,PRCFCT,PRCFEND,PRCFENDX
|
|
KILL PRCFI,PRCFMOP,PRCFOS,PRCFOT,PRCFSITE,TO,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
|
|
QUIT
|
|
DEV W ! K IO("Q") S %ZIS("B")="HOME",%ZIS="QM" D ^%ZIS Q
|
|
AGN W !!,"Would you like to run another reconciliation report" S %=2 D YN^DICN G AGN:%=0 Q
|