GECSSTAA ;WISC/RFJ,KLD-stacker file utilities ;24 Nov 93
;;2.0;GCS;**4,5,10,12,19,26,27,28**;MAR 14, 1995
Q
;
;
ADD(SEGMENT,CONTROL,BATCH,DOCUMENT,DESCRIPT) ; add entry to stack file
; segment = code sheet segment from file 2101.2
; control = control segment
; batch = batch segment (optional, use "" if not defined)
; document = doc and <tc>1 segments (optional, use "" if not defined)
; descript = 79 character description of event
; return internal entry number
N %,%H,%I,DA,DATE,DIE,DR,TIME,TRANID,X,GDT
L +^GECS(2100.1,0)
S %=^GECS(2100.1,0)
F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2100.1,DA))
S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2100.1,0)=%
L -^GECS(2100.1,0)
;
L +^GECS(2100.1,DA)
S DATE=$P(CONTROL,"^",10),DATE=($E(DATE,1,2)-17)_$E(DATE,3,8)
S TIME=$P(CONTROL,"^",11)
S TRANID=$P(CONTROL,"^",6)_"-"_$P(CONTROL,"^",9) I $P(CONTROL,"^",8) S TRANID=TRANID_"-"_$P(CONTROL,"^",8)
; NEW ENTRY FOR NOIS
; for transaction class not equal DOC (i.e. VRQ)
I $P(CONTROL,"^",6)=" " S $P(TRANID,"-")=$E($P(CONTROL,"^",5),1,2)
; ORG ENTRY
S ^GECS(2100.1,DA,0)=TRANID_"^F^^^"_SEGMENT_"^"_$S($P(CONTROL,"^",2)="CFD":"M",1:"A")
S GDT=DATE_"."_TIME
S DR="2///^S X=GDT",DIE=2100.1 D ^DIE
I $L(DESCRIPT) S ^GECS(2100.1,DA,1)=$E(DESCRIPT,1,79)
S ^GECS(2100.1,"B",TRANID,DA)=""
S %=$E($P(TRANID,"-",2),4,9) I $L(%) S ^GECS(2100.1,"BID",%,DA)=""
K ^GECS(2100.1,DA,10)
D SETCS(DA,CONTROL)
I $P(CONTROL,"^",8),BATCH'="" D SETCS(DA,BATCH)
I DOCUMENT'="" D SETCS(DA,DOCUMENT)
L -^GECS(2100.1,DA)
Q DA
;
;
SETCS(DA,DATA) ; set data in wp code sheet field
; da = stack internal entry number
; data = code sheet data to store
; dt must be set to standard date prior to call
I '$D(^GECS(2100.1,DA)) Q
L +^GECS(2100.1,DA)
I '$D(^GECS(2100.1,DA,10,0)) S ^(0)="^^0^0^"_DT
N HOLDDATE,I,X,Y
F I=$P($G(^GECS(2100.1,DA,10,0)),"^",3)+1:1 Q:'$D(^GECS(2100.1,DA,10,I,0))
S $P(^GECS(2100.1,DA,10,0),"^",3,4)=I_"^"_I
S DATA=$TR(DATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S ^GECS(2100.1,DA,10,I,0)=DATA
S $P(^GECS(2100.1,DA,11),"^")=$P($G(^GECS(2100.1,DA,11)),"^")+$L(DATA)
; compute checksum
S X=$P(^GECS(2100.1,DA,11),"^",2)_DATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S $P(^GECS(2100.1,DA,11),"^",2)=Y
; find hold date
I $E($P(DATA,"^"),3)=2!($P(DATA,"^")="AT1") S HOLDDATE=$$HOLDDATE^GECSSTTR(DATA) I HOLDDATE S $P(^GECS(2100.1,DA,11),"^",3)=HOLDDATE
L -^GECS(2100.1,DA)
Q
;
;
SETSTAT(DA,STATUS) ; mark entry in stack for transmission
; da = stack internal entry number
; status = Queued for tran; Marked for tran by event
; Transmitted; Error in transmission
I "QMTEARF"'[$E(STATUS) Q
N %,GECSFAUT,DIR
S %=$G(^GECS(2100.1,DA,0)) I %="" Q
L +^GECS(2100.1,DA)
I $P(%,"^",4)'="" K ^GECS(2100.1,"AS",$P(%,"^",4),DA)
S $P(^GECS(2100.1,DA,0),"^",4)=$E(STATUS)
I $L(STATUS) S ^GECS(2100.1,"AS",$E(STATUS),DA)=""
L -^GECS(2100.1,DA)
I STATUS="M" D
. K ^TMP($J,"GECSSTTR")
. S GECSFAUT=1
. D BUILD^GECSSTTM(DA)
. D TRANSMIT^GECSSTTT
. K ^TMP($J,"GECSSTTR")
Q
;
;
SETKEY(DA,KEY) ; set the key for document lookup
I '$D(^GECS(2100.1,DA,0)) Q
N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^GECS(2100.1,",DR="8///"_KEY_";"
; if key is null, delete it
I KEY="" S DR="8///@;"
D ^DIE
Q
;
;
CHEKDUPL(DATA) ; called from control input template to check for duplicate
; entry in the stack file.
; data=same as "fms" node in file 2100
; =transcode^transnumber
N TRANNUMB
S TRANNUMB=$E($P(DATA,"^",2)_" ",1,11)
I $D(^GECS(2100.1,"B",$P(DATA,"^")_"-"_TRANNUMB)) Q 1
Q 0
;
;
SELECT(GECSTRAN,GECSSITE,GECSSTAT,GECSSCRN,GECSPROM) ; select stack entry
; gecstran = optional screen transaction types (delimit using ^)
; gecssite = optional screen for station number
; gecsstat = optional screen for status (delimit using ^)
; gecsscrn = optional additional screen which is executed
; gecsprom = optional prompt
; return internal entry of stack selected ^ document id
N %,%Y,DDH,DIC,GECSDATA,SCREEN,X,Y
S DIC="^GECS(2100.1,",DIC(0)="QEAMZ",DIC("A")="Select Stack Document for Retransmission: "
I $G(GECSPROM)'="" S DIC("A")=GECSPROM
S SCREEN="S GECSDATA=$G(^GECS(2100.1,+Y,0))"
I $G(GECSTRAN)'="" S SCREEN=SCREEN_" I GECSTRAN[$E(GECSDATA,1,2)"
I $G(GECSSITE)'="" S SCREEN=SCREEN_" I $E($P(GECSDATA,""-"",2),1,3)=GECSSITE"
I $G(GECSSTAT)'="" S SCREEN=SCREEN_" I GECSSTAT[$P(GECSDATA,U,4)"
I $G(GECSSCRN)'="" S SCREEN=SCREEN_" X GECSSCRN"
S DIC("S")=SCREEN
W ! D ^DIC
Q $S(Y>0:+Y_"^"_$P(Y,"^",2),1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSTAA 4701 printed Dec 13, 2024@01:56:28 Page 2
GECSSTAA ;WISC/RFJ,KLD-stacker file utilities ;24 Nov 93
+1 ;;2.0;GCS;**4,5,10,12,19,26,27,28**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
ADD(SEGMENT,CONTROL,BATCH,DOCUMENT,DESCRIPT) ; add entry to stack file
+1 ; segment = code sheet segment from file 2101.2
+2 ; control = control segment
+3 ; batch = batch segment (optional, use "" if not defined)
+4 ; document = doc and <tc>1 segments (optional, use "" if not defined)
+5 ; descript = 79 character description of event
+6 ; return internal entry number
+7 NEW %,%H,%I,DA,DATE,DIE,DR,TIME,TRANID,X,GDT
+8 LOCK +^GECS(2100.1,0)
+9 SET %=^GECS(2100.1,0)
+10 FOR DA=$PIECE(%,"^",3)+1:1
if '$DATA(^GECS(2100.1,DA))
QUIT
+11 SET $PIECE(%,"^",3)=DA
SET $PIECE(%,"^",4)=$PIECE(%,"^",4)+1
SET ^GECS(2100.1,0)=%
+12 LOCK -^GECS(2100.1,0)
+13 ;
+14 LOCK +^GECS(2100.1,DA)
+15 SET DATE=$PIECE(CONTROL,"^",10)
SET DATE=($EXTRACT(DATE,1,2)-17)_$EXTRACT(DATE,3,8)
+16 SET TIME=$PIECE(CONTROL,"^",11)
+17 SET TRANID=$PIECE(CONTROL,"^",6)_"-"_$PIECE(CONTROL,"^",9)
IF $PIECE(CONTROL,"^",8)
SET TRANID=TRANID_"-"_$PIECE(CONTROL,"^",8)
+18 ; NEW ENTRY FOR NOIS
+19 ; for transaction class not equal DOC (i.e. VRQ)
+20 IF $PIECE(CONTROL,"^",6)=" "
SET $PIECE(TRANID,"-")=$EXTRACT($PIECE(CONTROL,"^",5),1,2)
+21 ; ORG ENTRY
+22 SET ^GECS(2100.1,DA,0)=TRANID_"^F^^^"_SEGMENT_"^"_$SELECT($PIECE(CONTROL,"^",2)="CFD":"M",1:"A")
+23 SET GDT=DATE_"."_TIME
+24 SET DR="2///^S X=GDT"
SET DIE=2100.1
DO ^DIE
+25 IF $LENGTH(DESCRIPT)
SET ^GECS(2100.1,DA,1)=$EXTRACT(DESCRIPT,1,79)
+26 SET ^GECS(2100.1,"B",TRANID,DA)=""
+27 SET %=$EXTRACT($PIECE(TRANID,"-",2),4,9)
IF $LENGTH(%)
SET ^GECS(2100.1,"BID",%,DA)=""
+28 KILL ^GECS(2100.1,DA,10)
+29 DO SETCS(DA,CONTROL)
+30 IF $PIECE(CONTROL,"^",8)
IF BATCH'=""
DO SETCS(DA,BATCH)
+31 IF DOCUMENT'=""
DO SETCS(DA,DOCUMENT)
+32 LOCK -^GECS(2100.1,DA)
+33 QUIT DA
+34 ;
+35 ;
SETCS(DA,DATA) ; set data in wp code sheet field
+1 ; da = stack internal entry number
+2 ; data = code sheet data to store
+3 ; dt must be set to standard date prior to call
+4 IF '$DATA(^GECS(2100.1,DA))
QUIT
+5 LOCK +^GECS(2100.1,DA)
+6 IF '$DATA(^GECS(2100.1,DA,10,0))
SET ^(0)="^^0^0^"_DT
+7 NEW HOLDDATE,I,X,Y
+8 FOR I=$PIECE($GET(^GECS(2100.1,DA,10,0)),"^",3)+1:1
if '$DATA(^GECS(2100.1,DA,10,I,0))
QUIT
+9 SET $PIECE(^GECS(2100.1,DA,10,0),"^",3,4)=I_"^"_I
+10 SET DATA=$TRANSLATE(DATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+11 SET ^GECS(2100.1,DA,10,I,0)=DATA
+12 SET $PIECE(^GECS(2100.1,DA,11),"^")=$PIECE($GET(^GECS(2100.1,DA,11)),"^")+$LENGTH(DATA)
+13 ; compute checksum
+14 SET X=$PIECE(^GECS(2100.1,DA,11),"^",2)_DATA
XECUTE $SELECT($GET(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""")
SET $PIECE(^GECS(2100.1,DA,11),"^",2)=Y
+15 ; find hold date
+16 IF $EXTRACT($PIECE(DATA,"^"),3)=2!($PIECE(DATA,"^")="AT1")
SET HOLDDATE=$$HOLDDATE^GECSSTTR(DATA)
IF HOLDDATE
SET $PIECE(^GECS(2100.1,DA,11),"^",3)=HOLDDATE
+17 LOCK -^GECS(2100.1,DA)
+18 QUIT
+19 ;
+20 ;
SETSTAT(DA,STATUS) ; mark entry in stack for transmission
+1 ; da = stack internal entry number
+2 ; status = Queued for tran; Marked for tran by event
+3 ; Transmitted; Error in transmission
+4 IF "QMTEARF"'[$EXTRACT(STATUS)
QUIT
+5 NEW %,GECSFAUT,DIR
+6 SET %=$GET(^GECS(2100.1,DA,0))
IF %=""
QUIT
+7 LOCK +^GECS(2100.1,DA)
+8 IF $PIECE(%,"^",4)'=""
KILL ^GECS(2100.1,"AS",$PIECE(%,"^",4),DA)
+9 SET $PIECE(^GECS(2100.1,DA,0),"^",4)=$EXTRACT(STATUS)
+10 IF $LENGTH(STATUS)
SET ^GECS(2100.1,"AS",$EXTRACT(STATUS),DA)=""
+11 LOCK -^GECS(2100.1,DA)
+12 IF STATUS="M"
Begin DoDot:1
+13 KILL ^TMP($JOB,"GECSSTTR")
+14 SET GECSFAUT=1
+15 DO BUILD^GECSSTTM(DA)
+16 DO TRANSMIT^GECSSTTT
+17 KILL ^TMP($JOB,"GECSSTTR")
End DoDot:1
+18 QUIT
+19 ;
+20 ;
SETKEY(DA,KEY) ; set the key for document lookup
+1 IF '$DATA(^GECS(2100.1,DA,0))
QUIT
+2 NEW %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
+3 SET (DIC,DIE)="^GECS(2100.1,"
SET DR="8///"_KEY_";"
+4 ; if key is null, delete it
+5 IF KEY=""
SET DR="8///@;"
+6 DO ^DIE
+7 QUIT
+8 ;
+9 ;
CHEKDUPL(DATA) ; called from control input template to check for duplicate
+1 ; entry in the stack file.
+2 ; data=same as "fms" node in file 2100
+3 ; =transcode^transnumber
+4 NEW TRANNUMB
+5 SET TRANNUMB=$EXTRACT($PIECE(DATA,"^",2)_" ",1,11)
+6 IF $DATA(^GECS(2100.1,"B",$PIECE(DATA,"^")_"-"_TRANNUMB))
QUIT 1
+7 QUIT 0
+8 ;
+9 ;
SELECT(GECSTRAN,GECSSITE,GECSSTAT,GECSSCRN,GECSPROM) ; select stack entry
+1 ; gecstran = optional screen transaction types (delimit using ^)
+2 ; gecssite = optional screen for station number
+3 ; gecsstat = optional screen for status (delimit using ^)
+4 ; gecsscrn = optional additional screen which is executed
+5 ; gecsprom = optional prompt
+6 ; return internal entry of stack selected ^ document id
+7 NEW %,%Y,DDH,DIC,GECSDATA,SCREEN,X,Y
+8 SET DIC="^GECS(2100.1,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Stack Document for Retransmission: "
+9 IF $GET(GECSPROM)'=""
SET DIC("A")=GECSPROM
+10 SET SCREEN="S GECSDATA=$G(^GECS(2100.1,+Y,0))"
+11 IF $GET(GECSTRAN)'=""
SET SCREEN=SCREEN_" I GECSTRAN[$E(GECSDATA,1,2)"
+12 IF $GET(GECSSITE)'=""
SET SCREEN=SCREEN_" I $E($P(GECSDATA,""-"",2),1,3)=GECSSITE"
+13 IF $GET(GECSSTAT)'=""
SET SCREEN=SCREEN_" I GECSSTAT[$P(GECSDATA,U,4)"
+14 IF $GET(GECSSCRN)'=""
SET SCREEN=SCREEN_" X GECSSCRN"
+15 SET DIC("S")=SCREEN
+16 WRITE !
DO ^DIC
+17 QUIT $SELECT(Y>0:+Y_"^"_$PIECE(Y,"^",2),1:0)
