source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDRPA09.m@ 861

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1SDRPA09 ;BP-OIFO/SWO,ESW - rejection utility ; 12/16/03 8:25am [2/19/04 5:24pm]
2 ;;5.3;Scheduling;**333**;Aug 13, 199
3 ;Rejection processing of all batches from the first run
4 ;
5 ;
6SELECT ;Select Batch Control Id for the rejection process
7 N SDPT,SDAR,DIC,Y,SDBM,SDBS,SDOUT S SDPT=0,SDOUT=1 N % S %=0 F Q:(%=1!(SDOUT=0)) S DIC="409.6",DIC(0)="QEAMZ",DIC("A")="Select running date:" D ^DIC Q:Y<1 S SDPT=+Y D Q:SDOUT=0
8 .S SDPT=+Y
9 .I SDPT>0 W !,"Correct Running Date? " S %=1 D YN^DICN D:(%=1) Q:Y<1
10 ..N DA S DIR(0)="409.7,.01" F D ^DIR S SDB=+Y Q:'SDB D
11 ...I $D(^SDWL(409.6,SDPT,2,"B",SDB)) S SDBS=$O(^SDWL(409.6,SDPT,2,"B",SDB,"")) D Q
12 ....I $P(^SDWL(409.6,SDPT,2,SDBS,0),"^",5)'="" W !,"Batch already Acknowledged!" Q
13 ....S SDBM=$P(^SDWL(409.6,SDPT,2,SDBS,0),"^",3),SDAR(SDBM)=SDB
14 ...I '$D(^SDWL(409.6,SDPT,2,"B",SDB)) W !,"Non existing batch control ID from this run!" Q
15 ..I '$O(SDAR("")) W !,"No Batches Selected, OK to quit? " S %=1 D YN^DICN S SDOUT=0 Q
16 Q:'$D(SDAR)
17QUE W !!,"This job has been tasked"
18 N ZTSAVE,IOP S IOP=0 F X="SDPT","SDAR(","IOP" S ZTSAVE(X)=""
19 W ! D EN^XUTMDEVQ("STRT^SDRPA09","Whole Batch Rejection Report",.ZTSAVE) S SDOUT=0 Q
20 Q
21STRT ;Tasked Entry
22 N BATCHID0,SDB,V4
23 S SDB="" F S SDB=$O(SDAR(SDB)) Q:SDB="" S BATCHID0=SDAR(SDB) D AR(SDB) D D MSG^SDRPA06(BATCHID0,3,SDPT,SDB)
24 .S V4=$O(^SDWL(409.6,SDPT,2,"B",BATCHID0,""))
25 .S DA=V4,DA(1)=SDPT,DIE="^SDWL(409.6,"_SDPT_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_"MR"
26 .D ^DIE K DIE
27 Q
28AR(BATCH) ;whole batch rejection
29 ;BATCH : originating batch number
30 ;V1 : sequence # (individual message number in batch)
31 ;V2 : run # (ien of multiple entry)
32 ;V3 : ien (ien in multiple)
33 N DA,DIE,DR,V1,V2,V3,ZNODE
34 S V1=0
35 F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
36 . S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
37 . S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
38 .. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
39 .. ;4TH PIECE IS MESSAGE NUMBER
40 .. S DA=V3,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",1,"
41 .. S DR="7///R" D ^DIE
42 .. I $D(^SDWL(409.6,"AE","Y",V2,V3)) Q
43 .. I $D(^SDWL(409.6,"AE","N",V2,V3)) D
44 ... S DR="4///Y" D ^DIE
45 Q
Note: See TracBrowser for help on using the repository browser.