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