source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUA.m@ 1420

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCUA ;WISC/PLT-One time use utility ; 01/03/94 8:37 AM
2V ;;5.0;IFCAP;;4/21/95
3 QUIT ;invalid entry
4EN1 ;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
6Q1 W !! D YN^PRC0A(.X,.Y,$P($T(EN1),";",2,999),"","YES") G EXIT:Y'=1
7Q2 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
13ETM 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
27EXIT QUIT
28 ;
Note: See TracBrowser for help on using the repository browser.