- 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 Jan 18, 2025@02:57:41 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