source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFPR3.m@ 623

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCFPR3 ;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.
4DQ ;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
11PROC 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))
18END Q
Note: See TracBrowser for help on using the repository browser.