| 1 | PRCFPR3 ;WISC/LDB-QUEUED PRINT OF STACK DOCUMENTS ;8/7/92 2:16 PM [ 08/07/92 3:32 PM ]
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DQ ;Called from PRCFA STACK DOCUMENTS PRINT option to print entries
|
|---|
| 5 | ;in file 421.8 by date as background job
|
|---|
| 6 | D DT^DICRW,NOW^%DTC S U="^",PRCDT=+$E(%,1,12)
|
|---|
| 7 | 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
|
|---|
| 8 | .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
|
|---|
| 9 | 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
|
|---|
| 10 | K ALL,PRCDA,PRCD0,PRCHNRQ,RTN,TYPE,VAR,^TMP("PRCREC",$J) Q
|
|---|
| 11 | 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)
|
|---|
| 12 | S RTN=$TR($P(^PRC(421.8,PRCDA,0),"^",3),"*","^")
|
|---|
| 13 | I $D(PRCHXXD1) S D1=PRCHXXD1
|
|---|
| 14 | N DATE1,DATE2,TYPE,ALL S D0=PRCD0 N PRCD0
|
|---|
| 15 | D @RTN K PRCHNRQ,D0,D1,DA
|
|---|
| 16 | S DA=PRCDA,DIE="^PRC(421.8,",DR="8////^S X=PRCDT" D ^DIE
|
|---|
| 17 | 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))
|
|---|
| 18 | END Q
|
|---|
