| [613] | 1 | PRCSRDIS ;WISC/KMB/CODE FOR CROSS REF CREATION ;11/28/94 12:01 PM
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ; place existing temp trans from last 180 days on "K" cross ref
|
|---|
| 5 | S (PRC("CP"),PRC("SITE"))=0,U="^"
|
|---|
| 6 | D:'$D(DT) DT^DICRW S XTEST=$$FMADD^XLFDT(DT,-180,0,0,0)
|
|---|
| 7 | S (PZIP,PZIP1)=0 F II=0:0 S PZIP=$O(^PRCS(410,"H",PZIP)) Q:PZIP="" D
|
|---|
| 8 | .S PZIP1=$O(^PRCS(410,"H",PZIP,PZIP1)) Q:PZIP1="" D
|
|---|
| 9 | ..N REF,REF1 S REF=$P($G(^PRCS(410,PZIP1,0)),"^"),REF1=$P($G(^PRCS(410,PZIP1,0)),"^",3) Q:REF'=REF1
|
|---|
| 10 | ..S XCP=+$P($G(^PRCS(410,PZIP1,3)),"^"),CDATE=$P($G(^PRCS(410,PZIP1,1)),"^")
|
|---|
| 11 | ..I CDATE<XTEST Q
|
|---|
| 12 | ..S ^PRCS(410,"K",XCP,PZIP1)="",$P(^PRCS(410,PZIP1,6),"^",4)=XCP
|
|---|
| 13 | K REF,REF1,XTEST,II,XCP,CDATE,PZIP,PZIP1,PRC Q
|
|---|
| 14 | TEMPDIS ; display temp. trans to clerks
|
|---|
| 15 | ; is this subroutine used? may be beneficial for testing clerk display
|
|---|
| 16 | N PRCSI,PRCSJ,COUNT
|
|---|
| 17 | Q:'$D(DUZ) S (PRC("CP"),PRC("SITE"))=0,U="^"
|
|---|
| 18 | F PRCSI=0:0 S PRC("SITE")=$O(^PRC(420,"A",DUZ,PRC("SITE"))) Q:PRC("SITE")'>0 F PRCSJ=0:0 S PRC("CP")=$O(^PRC(420,"A",DUZ,PRC("SITE"),+PRC("CP"))) Q:PRC("CP")'>0 D CHECK
|
|---|
| 19 | QUIT
|
|---|
| 20 | CHECK ; this subroutine is called from PRCSUT1
|
|---|
| 21 | S COUNT=0
|
|---|
| 22 | F LOOP1=0:0 S LOOP1=$O(^PRCS(410,"K",+PRC("CP"),LOOP1)) Q:LOOP1="" D
|
|---|
| 23 | .I +$P(^PRCS(410,LOOP1,0),"^",5)=+PRC("SITE") S COUNT=COUNT+1
|
|---|
| 24 | I COUNT>0 W !,"You have ",COUNT," request(s) to process in station "_PRC("SITE")_", CP ",PRC("CP")
|
|---|
| 25 | Q
|
|---|
