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