Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GECSSTAA

GECSSTAA.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ;
  1. ;
  1. ADD(SEGMENT,CONTROL,BATCH,DOCUMENT,DESCRIPT) ; add entry to stack file
  1. ; segment = code sheet segment from file 2101.2
  1. ; control = control segment
  1. ; batch = batch segment (optional, use "" if not defined)
  1. ; document = doc and <tc>1 segments (optional, use "" if not defined)
  1. ; descript = 79 character description of event
  1. ; return internal entry number
  1. N %,%H,%I,DA,DATE,DIE,DR,TIME,TRANID,X,GDT
  1. L +^GECS(2100.1,0)
  1. S %=^GECS(2100.1,0)
  1. F DA=$P(%,"^",3)+1:1 Q:'$D(^GECS(2100.1,DA))
  1. S $P(%,"^",3)=DA,$P(%,"^",4)=$P(%,"^",4)+1,^GECS(2100.1,0)=%
  1. L -^GECS(2100.1,0)
  1. ;
  1. L +^GECS(2100.1,DA)
  1. S DATE=$P(CONTROL,"^",10),DATE=($E(DATE,1,2)-17)_$E(DATE,3,8)
  1. S TIME=$P(CONTROL,"^",11)
  1. S TRANID=$P(CONTROL,"^",6)_"-"_$P(CONTROL,"^",9) I $P(CONTROL,"^",8) S TRANID=TRANID_"-"_$P(CONTROL,"^",8)
  1. ; NEW ENTRY FOR NOIS
  1. ; for transaction class not equal DOC (i.e. VRQ)
  1. I $P(CONTROL,"^",6)=" " S $P(TRANID,"-")=$E($P(CONTROL,"^",5),1,2)
  1. ; ORG ENTRY
  1. S ^GECS(2100.1,DA,0)=TRANID_"^F^^^"_SEGMENT_"^"_$S($P(CONTROL,"^",2)="CFD":"M",1:"A")
  1. S GDT=DATE_"."_TIME
  1. S DR="2///^S X=GDT",DIE=2100.1 D ^DIE
  1. I $L(DESCRIPT) S ^GECS(2100.1,DA,1)=$E(DESCRIPT,1,79)
  1. S ^GECS(2100.1,"B",TRANID,DA)=""
  1. S %=$E($P(TRANID,"-",2),4,9) I $L(%) S ^GECS(2100.1,"BID",%,DA)=""
  1. K ^GECS(2100.1,DA,10)
  1. D SETCS(DA,CONTROL)
  1. I $P(CONTROL,"^",8),BATCH'="" D SETCS(DA,BATCH)
  1. I DOCUMENT'="" D SETCS(DA,DOCUMENT)
  1. L -^GECS(2100.1,DA)
  1. Q DA
  1. ;
  1. ;
  1. SETCS(DA,DATA) ; set data in wp code sheet field
  1. ; da = stack internal entry number
  1. ; data = code sheet data to store
  1. ; dt must be set to standard date prior to call
  1. I '$D(^GECS(2100.1,DA)) Q
  1. L +^GECS(2100.1,DA)
  1. I '$D(^GECS(2100.1,DA,10,0)) S ^(0)="^^0^0^"_DT
  1. N HOLDDATE,I,X,Y
  1. F I=$P($G(^GECS(2100.1,DA,10,0)),"^",3)+1:1 Q:'$D(^GECS(2100.1,DA,10,I,0))
  1. S $P(^GECS(2100.1,DA,10,0),"^",3,4)=I_"^"_I
  1. S DATA=$TR(DATA,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. S ^GECS(2100.1,DA,10,I,0)=DATA
  1. S $P(^GECS(2100.1,DA,11),"^")=$P($G(^GECS(2100.1,DA,11)),"^")+$L(DATA)
  1. ; compute checksum
  1. 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
  1. ; find hold date
  1. 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
  1. L -^GECS(2100.1,DA)
  1. Q
  1. ;
  1. ;
  1. SETSTAT(DA,STATUS) ; mark entry in stack for transmission
  1. ; da = stack internal entry number
  1. ; status = Queued for tran; Marked for tran by event
  1. ; Transmitted; Error in transmission
  1. I "QMTEARF"'[$E(STATUS) Q
  1. N %,GECSFAUT,DIR
  1. S %=$G(^GECS(2100.1,DA,0)) I %="" Q
  1. L +^GECS(2100.1,DA)
  1. I $P(%,"^",4)'="" K ^GECS(2100.1,"AS",$P(%,"^",4),DA)
  1. S $P(^GECS(2100.1,DA,0),"^",4)=$E(STATUS)
  1. I $L(STATUS) S ^GECS(2100.1,"AS",$E(STATUS),DA)=""
  1. L -^GECS(2100.1,DA)
  1. I STATUS="M" D
  1. . K ^TMP($J,"GECSSTTR")
  1. . S GECSFAUT=1
  1. . D BUILD^GECSSTTM(DA)
  1. . D TRANSMIT^GECSSTTT
  1. . K ^TMP($J,"GECSSTTR")
  1. Q
  1. ;
  1. ;
  1. SETKEY(DA,KEY) ; set the key for document lookup
  1. I '$D(^GECS(2100.1,DA,0)) Q
  1. N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
  1. S (DIC,DIE)="^GECS(2100.1,",DR="8///"_KEY_";"
  1. ; if key is null, delete it
  1. I KEY="" S DR="8///@;"
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. CHEKDUPL(DATA) ; called from control input template to check for duplicate
  1. ; entry in the stack file.
  1. ; data=same as "fms" node in file 2100
  1. ; =transcode^transnumber
  1. N TRANNUMB
  1. S TRANNUMB=$E($P(DATA,"^",2)_" ",1,11)
  1. I $D(^GECS(2100.1,"B",$P(DATA,"^")_"-"_TRANNUMB)) Q 1
  1. Q 0
  1. ;
  1. ;
  1. SELECT(GECSTRAN,GECSSITE,GECSSTAT,GECSSCRN,GECSPROM) ; select stack entry
  1. ; gecstran = optional screen transaction types (delimit using ^)
  1. ; gecssite = optional screen for station number
  1. ; gecsstat = optional screen for status (delimit using ^)
  1. ; gecsscrn = optional additional screen which is executed
  1. ; gecsprom = optional prompt
  1. ; return internal entry of stack selected ^ document id
  1. N %,%Y,DDH,DIC,GECSDATA,SCREEN,X,Y
  1. S DIC="^GECS(2100.1,",DIC(0)="QEAMZ",DIC("A")="Select Stack Document for Retransmission: "
  1. I $G(GECSPROM)'="" S DIC("A")=GECSPROM
  1. S SCREEN="S GECSDATA=$G(^GECS(2100.1,+Y,0))"
  1. I $G(GECSTRAN)'="" S SCREEN=SCREEN_" I GECSTRAN[$E(GECSDATA,1,2)"
  1. I $G(GECSSITE)'="" S SCREEN=SCREEN_" I $E($P(GECSDATA,""-"",2),1,3)=GECSSITE"
  1. I $G(GECSSTAT)'="" S SCREEN=SCREEN_" I GECSSTAT[$P(GECSDATA,U,4)"
  1. I $G(GECSSCRN)'="" S SCREEN=SCREEN_" X GECSSCRN"
  1. S DIC("S")=SCREEN
  1. W ! D ^DIC
  1. Q $S(Y>0:+Y_"^"_$P(Y,"^",2),1:0)