- 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 Feb 19, 2025@00:26:49 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
