SDRPA09 ;BP-OIFO/SWO,ESW - rejection utility ;12/16/03 8:25am [2/19/04 5:24pm]
;;5.3;Scheduling;**333,639**;Aug 13, 1993;Build 7
;Rejection processing of all batches from the first run
;
;
SELECT ;Select Batch Control Id for the rejection process
; SD*639 Disable Manual Batch Reject option
D BMES^XPDUTL("This Manual Batch Reject option has been placed Out of Order")
D MES^XPDUTL("by SD*5.3*639.")
D MES^XPDUTL("")
Q
;
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
.S SDPT=+Y
.I SDPT>0 W !,"Correct Running Date? " S %=1 D YN^DICN D:(%=1) Q:Y<1
..N DA S DIR(0)="409.7,.01" F D ^DIR S SDB=+Y Q:'SDB D
...I $D(^SDWL(409.6,SDPT,2,"B",SDB)) S SDBS=$O(^SDWL(409.6,SDPT,2,"B",SDB,"")) D Q
....I $P(^SDWL(409.6,SDPT,2,SDBS,0),"^",5)'="" W !,"Batch already Acknowledged!" Q
....S SDBM=$P(^SDWL(409.6,SDPT,2,SDBS,0),"^",3),SDAR(SDBM)=SDB
...I '$D(^SDWL(409.6,SDPT,2,"B",SDB)) W !,"Non existing batch control ID from this run!" Q
..I '$O(SDAR("")) W !,"No Batches Selected, OK to quit? " S %=1 D YN^DICN S SDOUT=0 Q
Q:'$D(SDAR)
QUE W !!,"This job has been tasked"
N ZTSAVE,IOP S IOP=0 F X="SDPT","SDAR(","IOP" S ZTSAVE(X)=""
; IA #1519
W ! D EN^XUTMDEVQ("STRT^SDRPA09","Whole Batch Rejection Report",.ZTSAVE) S SDOUT=0 Q
Q
STRT ;Tasked Entry
N BATCHID0,SDB,V4
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)
.S V4=$O(^SDWL(409.6,SDPT,2,"B",BATCHID0,""))
.S DA=V4,DA(1)=SDPT,DIE="^SDWL(409.6,"_SDPT_",2,",DR=".04///"_$$NOW^XLFDT_";.05///"_"MR"
.D ^DIE K DIE
Q
AR(BATCH) ;whole batch rejection
;BATCH : originating batch number
;V1 : sequence # (individual message number in batch)
;V2 : run # (ien of multiple entry)
;V3 : ien (ien in multiple)
N DA,DIE,DR,V1,V2,V3,ZNODE
S V1=0
F S V1=$O(^SDWL(409.6,"AMSG",BATCH,V1)) Q:'V1 D
. S V2=$O(^SDWL(409.6,"AMSG",BATCH,V1,"")) Q:'V2
. S V3=0 F S V3=$O(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3)) Q:'V3 D
.. S ZNODE=$G(^SDWL(409.6,V2,1,V3,0)) Q:ZNODE=""
.. ;4TH PIECE IS MESSAGE NUMBER
.. S DA=V3,DA(1)=V2,DIE="^SDWL(409.6,"_V2_",1,"
.. S DR="7///R" D ^DIE
.. I $D(^SDWL(409.6,"AE","Y",V2,V3)) Q
.. I $D(^SDWL(409.6,"AE","N",V2,V3)) D
... S DR="4///Y" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRPA09 2425 printed Nov 22, 2024@18:10:11 Page 2
SDRPA09 ;BP-OIFO/SWO,ESW - rejection utility ;12/16/03 8:25am [2/19/04 5:24pm]
+1 ;;5.3;Scheduling;**333,639**;Aug 13, 1993;Build 7
+2 ;Rejection processing of all batches from the first run
+3 ;
+4 ;
SELECT ;Select Batch Control Id for the rejection process
+1 ; SD*639 Disable Manual Batch Reject option
+2 DO BMES^XPDUTL("This Manual Batch Reject option has been placed Out of Order")
+3 DO MES^XPDUTL("by SD*5.3*639.")
+4 DO MES^XPDUTL("")
+5 QUIT
+6 ;
+7 NEW SDPT,SDAR,DIC,Y,SDBM,SDBS,SDOUT
SET SDPT=0
SET SDOUT=1
NEW %
SET %=0
FOR
if (%=1!(SDOUT=0))
QUIT
SET DIC="409.6"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select running date:"
DO ^DIC
if Y<1
QUIT
SET SDPT=+Y
Begin DoDot:1
+8 SET SDPT=+Y
+9 IF SDPT>0
WRITE !,"Correct Running Date? "
SET %=1
DO YN^DICN
if (%=1)
Begin DoDot:2
+10 NEW DA
SET DIR(0)="409.7,.01"
FOR
DO ^DIR
SET SDB=+Y
if 'SDB
QUIT
Begin DoDot:3
+11 IF $DATA(^SDWL(409.6,SDPT,2,"B",SDB))
SET SDBS=$ORDER(^SDWL(409.6,SDPT,2,"B",SDB,""))
Begin DoDot:4
+12 IF $PIECE(^SDWL(409.6,SDPT,2,SDBS,0),"^",5)'=""
WRITE !,"Batch already Acknowledged!"
QUIT
+13 SET SDBM=$PIECE(^SDWL(409.6,SDPT,2,SDBS,0),"^",3)
SET SDAR(SDBM)=SDB
End DoDot:4
QUIT
+14 IF '$DATA(^SDWL(409.6,SDPT,2,"B",SDB))
WRITE !,"Non existing batch control ID from this run!"
QUIT
End DoDot:3
+15 IF '$ORDER(SDAR(""))
WRITE !,"No Batches Selected, OK to quit? "
SET %=1
DO YN^DICN
SET SDOUT=0
QUIT
End DoDot:2
if Y<1
QUIT
End DoDot:1
if SDOUT=0
QUIT
+16 if '$DATA(SDAR)
QUIT
QUE WRITE !!,"This job has been tasked"
+1 NEW ZTSAVE,IOP
SET IOP=0
FOR X="SDPT","SDAR(","IOP"
SET ZTSAVE(X)=""
+2 ; IA #1519
+3 WRITE !
DO EN^XUTMDEVQ("STRT^SDRPA09","Whole Batch Rejection Report",.ZTSAVE)
SET SDOUT=0
QUIT
+4 QUIT
STRT ;Tasked Entry
+1 NEW BATCHID0,SDB,V4
+2 SET SDB=""
FOR
SET SDB=$ORDER(SDAR(SDB))
if SDB=""
QUIT
SET BATCHID0=SDAR(SDB)
DO AR(SDB)
Begin DoDot:1
+3 SET V4=$ORDER(^SDWL(409.6,SDPT,2,"B",BATCHID0,""))
+4 SET DA=V4
SET DA(1)=SDPT
SET DIE="^SDWL(409.6,"_SDPT_",2,"
SET DR=".04///"_$$NOW^XLFDT_";.05///"_"MR"
+5 DO ^DIE
KILL DIE
End DoDot:1
DO MSG^SDRPA06(BATCHID0,3,SDPT,SDB)
+6 QUIT
AR(BATCH) ;whole batch rejection
+1 ;BATCH : originating batch number
+2 ;V1 : sequence # (individual message number in batch)
+3 ;V2 : run # (ien of multiple entry)
+4 ;V3 : ien (ien in multiple)
+5 NEW DA,DIE,DR,V1,V2,V3,ZNODE
+6 SET V1=0
+7 FOR
SET V1=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1))
if 'V1
QUIT
Begin DoDot:1
+8 SET V2=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,""))
if 'V2
QUIT
+9 SET V3=0
FOR
SET V3=$ORDER(^SDWL(409.6,"AMSG",BATCH,V1,V2,V3))
if 'V3
QUIT
Begin DoDot:2
+10 SET ZNODE=$GET(^SDWL(409.6,V2,1,V3,0))
if ZNODE=""
QUIT
+11 ;4TH PIECE IS MESSAGE NUMBER
+12 SET DA=V3
SET DA(1)=V2
SET DIE="^SDWL(409.6,"_V2_",1,"
+13 SET DR="7///R"
DO ^DIE
+14 IF $DATA(^SDWL(409.6,"AE","Y",V2,V3))
QUIT
+15 IF $DATA(^SDWL(409.6,"AE","N",V2,V3))
Begin DoDot:3
+16 SET DR="4///Y"
DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
