[613] | 1 | GECSMUT2 ;WISC/RFJ/KLD-maintenance utilities ;13 Oct 98
|
---|
| 2 | ;;2.0;GCS;**19,33**;MAR 14, 1995
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | ;
|
---|
| 6 | RETRAN ; mark a batch for retransmission
|
---|
| 7 | N %,GECS,GECSBATC,GECSDATA,GECSDICS
|
---|
| 8 | D ^GECSSITE Q:'$G(GECS("SITE"))
|
---|
| 9 | D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
|
---|
| 10 | S GECS("SITECOM")=GECS("SITE")_GECS("SITE1")
|
---|
| 11 | S GECSDICS="S %=^(0) I $P($P(%,U),""-"")=GECS(""SITECOM""),$P($P(%,U),""-"",2)=GECS(""SYSID""),$P(%,U,4)'="""",$P(%,U,3)=""T"",$S($P(%,U,6)="""":1,$P(%,U,6)=GECS(""BATDA""):1,1:0)"
|
---|
| 12 | F W ! S GECSBATC=$$BATCHSEL^GECSUSEL(GECSDICS) Q:'GECSBATC D
|
---|
| 13 | . S GECSDATA=$G(^GECS(2101.3,GECSBATC,0)) I GECSDATA="" Q
|
---|
| 14 | . I $E($P(GECSDATA,"^",4),1,5)=$E(DT,1,5),$E(DT,6,7)>9,$P(GECSDATA,"^",2)="AMS" D
|
---|
| 15 | . . W !!,"WARNING -- If you have already sent the AMIS code sheets for this month and the",!,"code sheets are duplicates, Austin will reject messages for each of the",!,"duplicates."
|
---|
| 16 | . S XP="READY TO MARK BATCH FOR RETRANSMISSION",XH="Enter 'YES' to mark batch for retransmission, 'NO' or '^' to exit."
|
---|
| 17 | . I $$YN^GECSUTIL(2)'=1 Q
|
---|
| 18 | . D MARK(GECSBATC)
|
---|
| 19 | . W !
|
---|
| 20 | . S %=0 F S %=$O(^GECS(2100,"AB",GECS("BATCH"),%)) Q:'% I $D(^GECS(2100,%,0)) D
|
---|
| 21 | . . S $P(^GECS(2100,%,"TRANS"),"^",2)="Y",^GECS(2100,"AE","Y",%)=""
|
---|
| 22 | . . W $J($P(^GECS(2100,%,0),"^"),10)
|
---|
| 23 | . . I $X>68 W !
|
---|
| 24 | . W !,"Batch Number ",GECS("BATCH")," ready for transmission."
|
---|
| 25 | Q
|
---|
| 26 | ;
|
---|
| 27 | ;
|
---|
| 28 | MARK(DA) ; mark batch for transmission
|
---|
| 29 | N D0,DDH,DI,DQ,DIC,DIE,DR,X,Y
|
---|
| 30 | S (DIC,DIE)="^GECS(2101.3,",DR=".5////B;4///@;5///@"
|
---|
| 31 | D ^DIE
|
---|
| 32 | K ^GECS(2101.3,DA,2)
|
---|
| 33 | Q
|
---|