source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFPR1.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1PRCFPR1 ;WISC/LDB-PRINT FROM STACKED DOCUMENTS LIST ;6/29/00 12:16
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4SELECT N DA,DIC,DIE,DIR,X,Y D ENS^%ZISS K ^TMP($J),^TMP("PRCREC")
5 S PRCF("X")="AS" D ^PRCFSITE Q:'%
6 S DIR("A")="Select the type of report to print",DIR(0)="S^1:PURCHASE ORDERS;2:RECEIVING REPORTS;3:1358s;4:2237s (GPFs)" D ^DIR G:$D(DIRUT) EXIT S TYPE=+Y
7 I '$D(^PRC(421.8,"AC",TYPE)) W !,"THERE ARE NO RECORDS OF THIS TYPE TO PRINT." G EXIT
8 W ! S DIR("A")="Would you like to print ALL the PROCESSED records of this type",DIR("B")="YES",DIR(0)="Y" D ^DIR S ALL=Y I $D(DUOUT)!($D(DTOUT)) G EXIT
9 G:'ALL DT
10 W ! S DIR("A")="Print ALL records including those that have been previously PRINTED",DIR("B")="NO",DIR(0)="Y" D ^DIR S PRNT=Y I $D(DTOUT)!$D(DUOUT) G EXIT
11 S DATE1=$O(^PRC(421.8,"AC",TYPE,0)) D NOW^%DTC S DATE2=$E(%,1,12) G TASK
12DT W ! K DIR S DIR(0)="DO^"_$O(^PRC(421.8,"AC",TYPE,0))_":"_(DT+.9999)_":EXT^S:X="""" X=$O(^PRC(421.8,""AC"",TYPE,0))",DIR("B")=$$DATE($O(^PRC(421.8,"AC",TYPE,0)))
13 S DIR("A")="Begin with which date",DIR("?",1)="Time is optional.",DIR("?")=" Enter the date to start range-"
14 D ^DIR S:'Y DATE1=$O(^PRC(421.8,"AC",TYPE,0)) G:$D(DTOUT)!$D(DUOUT) EXIT
15 S:Y DATE1=Y S DATEX=$P(DATE1,".")
16 W ! K DIR S DIR("A")="End with which date",DIR("?",1)="Time is optional.",DIR("?")=" Enter the date that will end the range-"
17 D NOW^%DTC S %=$E(%,1,12) S DIR(0)="DO^"_DATEX_":"_(DT+.9999)_":ET",DIR("B")=$$DATE(%) D ^DIR G:$D(DIRUT) EXIT S:$P(Y,".",2)="" $P(Y,".",2)=9999 S DATE2=Y,Y=0
18 I 'ALL D LST G:OUT EXIT
19 I 'ALL,'ZZ W !!,"NO RECORDS WERE PROCESSED" G EXIT
20RELST I 'ALL,Y K DIR S DIR(0)="YO",DIR("B")="NO",DIR("A")="Relist the requests" D ^DIR I Y D LST G:OUT EXIT G RELST
21 I 'ALL K DIR D
22 .S DY=18,DX=0 X IOXY S DIR(0)="LO^1:"_ZZ_"^K:X[""."" X",DIR("A")="Select the highlighted number(s) to print from the list",(DIR("??"),DIR("?"))="^D HLP^PRCFPR1"
23 .D ^DIR Q:$D(DIRUT) F P=1:1 S DA=$P(Y,",",P) Q:DA="" S:$G(^TMP($J,"PRCREC",DA)) TMP=^(DA),^TMP("PRCREC",$J,+TMP,$P(TMP,U,2))=""
24 G:'ALL&$D(DIRUT) EXIT
25TASK ;SET TASKMAN VARIABLES
26 W !
27 K %ZIS,DEV,IOP S %ZIS="NM",DEV=$O(^PRC(421.8,"AC",TYPE,0)),DEV=$O(^(DEV,0)),DEV=$O(^(DEV,0)),DEV=$S($D(^PRC(421.8,DEV,0)):$P(^(0),U,6),1:""),%ZIS("B")=DEV,IOP="Q" D ^%ZIS G:POP EXIT
28 S ZTRTN="DQ^PRCFPR3",ZTSAVE("TYPE")="",ZTSAVE("ALL")="",ZTSAVE("PRNT")="",ZTSAVE("DATE1")="",ZTSAVE("DATE2")=""
29 S ZTDESC="PRINT STACKED FISCAL DOCUMENTS"
30 I $D(^TMP("PRCREC",$J)) S ZTSAVE("^TMP(""PRCREC"",$J,")=""
31 D ^%ZTLOAD
32EXIT D ^%ZISC,KILL^%ZISS
33 K %,%ZIS,D0,D1,DA,DAT,DATE,DATE1,DATE2,DATEX,DIC,DIE,DIR,DTOUT,DUOUT,OUT,P,POP,PRC,PRCF,PRCHXXD1,PRNT,REC,TMP,TYPE,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZZ
34 K ^TMP("PRCREC",$J) Q
35 ;
36DATE(Y) D DD^%DT S DATE=Y
37 Q DATE
38 ;
39HDR W @IOF,!,IOINHI,?30,"LISTING OF ",$S(TYPE=1:"PURCHASE ORDERS",TYPE=2:"RECEIVING REPORTS",TYPE=4:"2237s (GPFs)",1:"1358s")
40 W ! S X="",$P(X,"=",IOM)="" W !,X
41 W !,"RECORD NUMBER",?35,"PROCESSED",?57,"PRINTED"
42 W ! S X="",$P(X,"=",IOM)="" W X,!,IOINLOW
43 Q
44 ;
45LST I 'ALL D HDR S (ZZ,OUT)=0,DAT=(DATE1-.0001) F S DAT=$O(^PRC(421.8,"AC",TYPE,DAT)) Q:'DAT!(DAT>(DATE2+.9999))!OUT D
46 .S REC=0 F S REC=$O(^PRC(421.8,"AC",TYPE,DAT,REC)) Q:REC="" S DA=0 F S DA=$O(^PRC(421.8,"AC",TYPE,DAT,REC,DA)) Q:'DA!OUT I $D(^PRC(421.8,DA,0)) D
47 ..Q:$P(^PRC(421.8,DA,0),"^",8)'=PRC("SITE")
48 ..S ZZ=ZZ+1 W !,IORVON,ZZ,".)",IORVOFF,?5," ",REC,?38,$$DATE(DAT) W:$P(^PRC(421.8,DA,0),U,7) ?60,$$DATE($P(^PRC(421.8,DA,0),U,7)) S ^TMP($J,"PRCREC",ZZ)=+^PRC(421.8,DA,0)_"^"_DA I ($Y+6)>IOSL D Q:OUT
49 ...R !,"Press RETURN to continue or '^' to exit: ",OUT:DTIME S:OUT="^" OUT=1 D:'OUT HDR
50 Q
51 ;
52HLP D LST S DY=18,DX=0 X IOXY W !,"Enter the highlighted number(s) or range of highlighted number(s) from the list.",!,"Examples are: 1 or 1,2,5 or 1-3,5"
53 S DY=20,DX=0 X IOXY Q
Note: See TracBrowser for help on using the repository browser.