GECSSTT1 ;WISC/RFJ/KLD-stacker file retransmission ;13 Oct 98
;;2.0;GCS;*19*;MAR 14, 1995
N DA,DATA,GECSDOC,GECSXMZ,STATUS,ABORT,DIR
F S DA=$$SELECT^GECSSTAA("","","","") Q:'DA S GECSDOC=$P(DA,"^",2),DA=+DA D
. L +^GECS(2100.1,DA):5 I '$T W !,"Another user is working with the stack document, try again later." Q
. S STATUS=$P(^GECS(2100.1,DA,0),"^",4) S:STATUS="" STATUS="?"
. W $C(7),!!?5,"Current Status: ",$$STATUS^GECSSGET(GECSDOC)
. I '$D(^GECS(2100.1,DA,10,1,0)) W !,"There is not a code sheet for this stack entry." Q
. I $$GET1^DIQ(2100.1,DA,3,"I")="F" D Q:ABORT
. . W !?18,"** FINAL DOCUMENTS CANNOT BE RETRANSMITTED **",!
. . S ABORT=1
. . S DIR(0)="E",DIR("A")="Enter RETURN or '^' to exit"
. . D ^DIR
. . Q
. I STATUS="A" W !,"WARNING: Accepted documents probably should not be retransmitted."
. S XP="Do you want to retransmit this document now",XH="Enter 'YES' to retransmit the document immediately, 'NO' or '^' to exit."
. W !!
. I $$YN^GECSUTIL(2)'=1 L -^GECS(2100.1,DA) Q
. ;
. ; move mail messages
. S GECSXMZ=0 F S GECSXMZ=$O(^GECS(2100.1,DA,20,GECSXMZ)) Q:'GECSXMZ S DATA=$G(^(GECSXMZ,0)) I DATA'="" D MESSAGE^GECSSTTR(DA,21,GECSXMZ) I $D(^GECS(2100.1,DA,21,GECSXMZ,0)) S ^(0)=DATA
. K ^GECS(2100.1,DA,20)
. D SETSTAT^GECSSTAA(DA,"M")
. S STATUS=$P(^GECS(2100.1,DA,0),"^",4) S:STATUS="" STATUS="?"
. W !?5,"NEW Status: ",$$STATUS^GECSSGET(GECSDOC)
. L -^GECS(2100.1,DA)
Q
;
;
CONFIRM(XMZ,CONFIRM) ; add confirmation number to mailman message number
; xmz=message number; confirm=confirmation number
; return the number of documents with message, 0 if none
S COUNT=0
S %=0 F S %=$O(^GECS(2100.1,"AM",XMZ,%)) Q:'% I $D(^GECS(2100.1,%,0)) D
. I $D(^GECS(2100.1,%,20,0)) L +^GECS(2100.1,%,20) S $P(^GECS(2100.1,%,20,0),"^",2)=CONFIRM L -^GECS(2100.1,%,20) S COUNT=COUNT+1
. I $D(^GECS(2100.1,%,21,0)) L +^GECS(2100.1,%,21) S $P(^GECS(2100.1,%,21,0),"^",2)=CONFIRM L -^GECS(2100.1,%,21) S COUNT=COUNT+1
Q COUNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSTT1 2091 printed Nov 22, 2024@17:06:37 Page 2
GECSSTT1 ;WISC/RFJ/KLD-stacker file retransmission ;13 Oct 98
+1 ;;2.0;GCS;*19*;MAR 14, 1995
+2 NEW DA,DATA,GECSDOC,GECSXMZ,STATUS,ABORT,DIR
+3 FOR
SET DA=$$SELECT^GECSSTAA("","","","")
if 'DA
QUIT
SET GECSDOC=$PIECE(DA,"^",2)
SET DA=+DA
Begin DoDot:1
+4 LOCK +^GECS(2100.1,DA):5
IF '$TEST
WRITE !,"Another user is working with the stack document, try again later."
QUIT
+5 SET STATUS=$PIECE(^GECS(2100.1,DA,0),"^",4)
if STATUS=""
SET STATUS="?"
+6 WRITE $CHAR(7),!!?5,"Current Status: ",$$STATUS^GECSSGET(GECSDOC)
+7 IF '$DATA(^GECS(2100.1,DA,10,1,0))
WRITE !,"There is not a code sheet for this stack entry."
QUIT
+8 IF $$GET1^DIQ(2100.1,DA,3,"I")="F"
Begin DoDot:2
+9 WRITE !?18,"** FINAL DOCUMENTS CANNOT BE RETRANSMITTED **",!
+10 SET ABORT=1
+11 SET DIR(0)="E"
SET DIR("A")="Enter RETURN or '^' to exit"
+12 DO ^DIR
+13 QUIT
End DoDot:2
if ABORT
QUIT
+14 IF STATUS="A"
WRITE !,"WARNING: Accepted documents probably should not be retransmitted."
+15 SET XP="Do you want to retransmit this document now"
SET XH="Enter 'YES' to retransmit the document immediately, 'NO' or '^' to exit."
+16 WRITE !!
+17 IF $$YN^GECSUTIL(2)'=1
LOCK -^GECS(2100.1,DA)
QUIT
+18 ;
+19 ; move mail messages
+20 SET GECSXMZ=0
FOR
SET GECSXMZ=$ORDER(^GECS(2100.1,DA,20,GECSXMZ))
if 'GECSXMZ
QUIT
SET DATA=$GET(^(GECSXMZ,0))
IF DATA'=""
DO MESSAGE^GECSSTTR(DA,21,GECSXMZ)
IF $DATA(^GECS(2100.1,DA,21,GECSXMZ,0))
SET ^(0)=DATA
+21 KILL ^GECS(2100.1,DA,20)
+22 DO SETSTAT^GECSSTAA(DA,"M")
+23 SET STATUS=$PIECE(^GECS(2100.1,DA,0),"^",4)
if STATUS=""
SET STATUS="?"
+24 WRITE !?5,"NEW Status: ",$$STATUS^GECSSGET(GECSDOC)
+25 LOCK -^GECS(2100.1,DA)
End DoDot:1
+26 QUIT
+27 ;
+28 ;
CONFIRM(XMZ,CONFIRM) ; add confirmation number to mailman message number
+1 ; xmz=message number; confirm=confirmation number
+2 ; return the number of documents with message, 0 if none
+3 SET COUNT=0
+4 SET %=0
FOR
SET %=$ORDER(^GECS(2100.1,"AM",XMZ,%))
if '%
QUIT
IF $DATA(^GECS(2100.1,%,0))
Begin DoDot:1
+5 IF $DATA(^GECS(2100.1,%,20,0))
LOCK +^GECS(2100.1,%,20)
SET $PIECE(^GECS(2100.1,%,20,0),"^",2)=CONFIRM
LOCK -^GECS(2100.1,%,20)
SET COUNT=COUNT+1
+6 IF $DATA(^GECS(2100.1,%,21,0))
LOCK +^GECS(2100.1,%,21)
SET $PIECE(^GECS(2100.1,%,21,0),"^",2)=CONFIRM
LOCK -^GECS(2100.1,%,21)
SET COUNT=COUNT+1
End DoDot:1
+7 QUIT COUNT
