| 1 | PRCUA ;WISC/PLT-One time use utility ; 01/03/94  8:37 AM
 | 
|---|
| 2 | V ;;5.0;IFCAP;;4/21/95
 | 
|---|
| 3 |  QUIT  ;invalid entry
 | 
|---|
| 4 | EN1 ;Set 'p.o. date' in file 442 equal to 1358 request 'date obligated' in file 410
 | 
|---|
| 5 |  N PRC410,PRC442,PRCA,PRCB,ZTSTOP,X,Y
 | 
|---|
| 6 | Q1 W !! D YN^PRC0A(.X,.Y,$P($T(EN1),";",2,999),"","YES") G EXIT:Y'=1
 | 
|---|
| 7 | Q2 W ! D YN^PRC0A(.X,.Y,"Queue This Task","","") G Q1:Y?1"^".E
 | 
|---|
| 8 |  W ! I Y=1 D  G EXIT
 | 
|---|
| 9 |  . S ZTSAVE("PRC*")="",ZTDESC=$P($T(EN1),";",2,999),ZTIO=""
 | 
|---|
| 10 |  . S ZTRTN="ETM^PRCUA" D ^%ZTLOAD
 | 
|---|
| 11 |  . W !,"TASK NUMBER ",$S($D(ZTSK):ZTSK_" assigned",1:"not assigned and try again")
 | 
|---|
| 12 |  . QUIT
 | 
|---|
| 13 | ETM S PRCA="",ZTSTOP=""
 | 
|---|
| 14 |  F  S PRCA=$O(^PRCS(410,"D",PRCA)) QUIT:PRCA=""  D  Q:ZTSTOP
 | 
|---|
| 15 |  . S PRC410=0 F  S PRC410=$O(^PRCS(410,"D",PRCA,PRC410)) QUIT:PRC410'?1.N  D  Q:ZTSTOP=1
 | 
|---|
| 16 |  .. W:'$D(ZTQUEUED)&(PRC410#200=0) "."
 | 
|---|
| 17 |  .. I $D(ZTQUEUED),PRC410#30=0 S ZTSTOP=$$S^%ZTLOAD Q:ZTSTOP=1
 | 
|---|
| 18 |  .. S PRCB=$G(^PRCS(410,PRC410,0)) Q:$P(PRCB,"^",4)'=1
 | 
|---|
| 19 |  .. S PRCB=$G(^PRCS(410,PRC410,10)),PRC442=$P(PRCB,"^",3) Q:PRC442=""
 | 
|---|
| 20 |  .. S PRCB=$G(^PRCS(410,PRC410,4)) Q:$P(PRCB,"^",5)=""!($P(PRCB,"^",4)="")
 | 
|---|
| 21 |  .. Q:$P($G(^PRC(442,PRC442,1)),"^",15)'=""
 | 
|---|
| 22 |  .. S DA=PRC442,DIE="^PRC(442,",DR=".1////"_$P(PRCB,"^",4) D ^DIE
 | 
|---|
| 23 |  .. QUIT
 | 
|---|
| 24 |  . QUIT
 | 
|---|
| 25 |  W:'$D(ZTQUEUED) !!,"Set p.o. date in file 442 is done.",!!
 | 
|---|
| 26 |  K:ZTSTOP'=1 ZTSTOP
 | 
|---|
| 27 | EXIT QUIT
 | 
|---|
| 28 |  ;
 | 
|---|