19 lines
1.3 KiB
Mathematica
19 lines
1.3 KiB
Mathematica
PRCFPR3 ;WISC/LDB-QUEUED PRINT OF STACK DOCUMENTS ;8/7/92 2:16 PM [ 08/07/92 3:32 PM ]
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
DQ ;Called from PRCFA STACK DOCUMENTS PRINT option to print entries
|
|
;in file 421.8 by date as background job
|
|
D DT^DICRW,NOW^%DTC S U="^",PRCDT=+$E(%,1,12)
|
|
I ALL S DATE1=DATE1-.0001 F S DATE1=$O(^PRC(421.8,"AB",TYPE,DATE1)) Q:'DATE1!(DATE1>(DATE2+.9999)) S PRCD0=0 F S PRCD0=$O(^PRC(421.8,"AB",TYPE,DATE1,PRCD0)) Q:'PRCD0 D
|
|
.S PRCDA=0 F S PRCDA=$O(^PRC(421.8,"AB",TYPE,DATE1,PRCD0,PRCDA)) Q:'PRCDA D:$S(PRNT:1,'PRNT&'$P($G(^PRC(421.8,PRCDA,0)),U,7):1,1:"") PROC
|
|
I 'ALL S PRCD0=0 F S PRCD0=$O(^TMP("PRCREC",$J,PRCD0)) Q:'PRCD0 S PRCDA=0 F S PRCDA=$O(^TMP("PRCREC",$J,PRCD0,PRCDA)) Q:'PRCDA D PROC
|
|
K ALL,PRCDA,PRCD0,PRCHNRQ,RTN,TYPE,VAR,^TMP("PRCREC",$J) Q
|
|
PROC S VAR=0 F S VAR=$O(^PRC(421.8,PRCDA,1,VAR)) Q:'VAR I $P($G(^(VAR,0)),U)'="",$P(^(0),U)'="DUZ" S @$P(^(0),U)=$P(^(0),U,2)
|
|
S RTN=$TR($P(^PRC(421.8,PRCDA,0),"^",3),"*","^")
|
|
I $D(PRCHXXD1) S D1=PRCHXXD1
|
|
N DATE1,DATE2,TYPE,ALL S D0=PRCD0 N PRCD0
|
|
D @RTN K PRCHNRQ,D0,D1,DA
|
|
S DA=PRCDA,DIE="^PRC(421.8,",DR="8////^S X=PRCDT" D ^DIE
|
|
S VAR=0 F S VAR=$O(^PRC(421.8,PRCDA,1,VAR)) Q:'VAR I $P($G(^(VAR,0)),U)'="",$P(^(0),U)'="DUZ" K @($P($G(^(0)),U))
|
|
END Q
|