GECSUFMS ;WISC/RFJ/KLD-fms utilities ;10/13/98
;;2.0;GCS;**7,8,15,19,30,31,34,40**;MAR 14, 1995;Build 13
Q
;
;GEC*2.0*40 Modified document MOA segment to insure the
; document transaction date used was from
; Committed Date in file 410 entry and handles
; the FY/FQ correctly when date is before
; or after current FY.
;
CONTROL(SYSTEM,STATION,DOCUMENT,TRANCODE,SECCODE,MODFLAG,FCPFLAG,DESCRIPT,COMMDATE) ; return fms control segment
; system = "A" for ar, "I" for ifcap, "E" for eng, "C" for create doc
; station = 3 digit station number
; document = source document [sta-po####xx] where xx=partial (opt)
; trancode = MO, SV, etc for class = DOC
; = VR for vendor requests
; seccode = security 1 code (usually '10 ')
; modflag = 1 for modification document (batch number auto gen)
; fcpflag = Y if transaction has updated ifcap fcp balance
; use only for tran-code AR, CR, IV, MO, SA, ST
; descript = description of event
; return gecsfms("ctl"), gecsfms("bat"), gecsfms("doc")
N %,%H,%I,BATNUMB,DATE,FY,H,M,S,SEGMENT,STACK,TIME,TRANCLAS,X,Y,SYSTEMI,GECOMDT ;GEC*2.0*40
K GECSFMS
S SYSTEMI=SYSTEM ; save initial system for rebuild
S SYSTEM=$S($E(SYSTEM)="A":"ARS",$E(SYSTEM)="I":"IFC",$E(SYSTEM)="E":"AMM",1:"CFD")
S STATION=$E(STATION,1,3)
S DOCUMENT=$E($TR(DOCUMENT,"-")_" ",1,11)
S TRANCODE=$E(TRANCODE,1,2)
S SECCODE=$E(SECCODE_" ",1,4)
GCOMDT D NOW^%DTC S Y=%,(GECOMDT,DATE)=X D DD^%DT ;GEC*2.0*40
I $G(COMMDATE) S GECOMDT=COMMDATE,TIME="100000"
S %=$P(Y,"@",2),H=$P(%,":"),M=$P(%,":",2),S=$P(%,":",3),H=$E("00",$L(H)+1,2)_H,M=$E("00",$L(M)+1,2)_M,S=$E("00",$L(S)+1,2)_S,TIME=H_M_S
S Y=X X ^DD("DD") S FY=$S(GECOMDT>($E(DATE,1,3)_"0930"):$E(DATE,2,3)+1,GECOMDT<DATE:999,1:$E(DATE,2,3)) ;GEC*2.0*40
I FY=999 D ;GEC*2.0*40
. I $E(GECOMDT,1,3)=$E(DATE,1,3)!((GECOMDT>($E(DATE,1,3)-1)_"0930")) S FY=$E(DATE,2,3) Q
. I GECOMDT>($E(GECOMDT,1,3)_"0930"),GECOMDT<($E(GECOMDT,1,3)_1232) S FY=$E(GECOMDT,2,3)+1 Q
. S FY=$E(GECOMDT,2,3)
S STACK=TRANCODE_"-"_DOCUMENT
; check if STACK exists in 2100.1 file
K GECSDATA
D DATA^GECSSGET(STACK,0)
I $G(GECSDATA)>0,MODFLAG'>0 S GECSTEST=GECSDATA D Q
. ;STACK entry exists. convert CONTROL call into REBUILD call
. D REBUILD^GECSUFM1(GECSDATA,SYSTEMI,SECCODE,FCPFLAG,DESCRIPT)
. S DA=GECSTEST,GECSFMS("DA")=GECSTEST
. K GECSDATA,GECSTEST
;
I MODFLAG F S %=$$ACOUNTER^GECSUNUM(STATION_"-FMS:BATCH-"_FY),%=$E(%,$L(%)-2,$L(%)),%=$E("000",$L(%)+1,3)_%,X=STACK_"-"_STATION_% I '$D(^GECS(2100.1,"B",X)) L +^GECS(2100.1,"AZ",X):0 I $T S STACK=X Q
S BATNUMB=$E($P(STACK,"-",3)_" ",1,6)
S TRANCLAS="DOC" I TRANCODE="VR" S TRANCLAS="VRQ",TRANCODE=" "
S GECSFMS("CTL")="CTL^"_SYSTEM_"^FMS^"_$E(STATION,1,3)_"^"_TRANCLAS_"^"_TRANCODE_"^"_SECCODE_"^"_$E(BATNUMB,1,6)_"^"_DOCUMENT_"^"_(17+$E(GECOMDT))_$E(GECOMDT,2,7)_"^"_TIME_"^001^001^001^"_$C(126) ;GEC*2.0*40
;
; vendor request, add ctl to stack and quit
I TRANCLAS="VRQ" D Q
. S GECSFMS("DA")=$$ADD^GECSSTAA("VR:FMS",GECSFMS("CTL"),"","",DESCRIPT)
. L -^GECS(2100.1,"AZ",STACK)
;
; change segment for specific transaction codes
S SEGMENT=TRANCODE
I TRANCODE="CF"!(TRANCODE="WR")!(TRANCODE="TR") S SEGMENT="CR"
I TRANCODE="DV"!(TRANCODE="ET") S SEGMENT="DD"
I TRANCODE="AO"!(TRANCODE="CO")!(TRANCODE="SO")!(TRANCODE="TG")!(TRANCODE="WO") S SEGMENT="MO"
I TRANCODE="AV"!(TRANCODE="CT")!(TRANCODE="MV")!(TRANCODE="OP")!(TRANCODE="PS")!(TRANCODE="TD") S SEGMENT="PV"
I TRANCODE="AR"!(TRANCODE="RT") S SEGMENT="RC"
I TRANCODE="BV" S SEGMENT="SV"
I TRANCODE="RO"!(TRANCODE="TZ") S SEGMENT="TO"
I TRANCODE="RV"!(TRANCODE="TY") S SEGMENT="TV"
; create bat segment
I MODFLAG S GECSFMS("BAT")="BAT^"_$C(126)_SEGMENT_"0^"_BATNUMB_"^"_$C(126)
; create doc and <tc>1 segments
I "RC^CR^TR^IV^MO^SA^ST"[SEGMENT S FCPFLAG=$S(FCPFLAG="Y":"Y",1:"N")_"^"
; security code is not on the sa1,st1 code sheets
S SECCODE=SECCODE_"^"
I "SA^ST"[SEGMENT S SECCODE=""
S GECSFMS("DOC")="DOC^"_$C(126)
; do not create <tc>1 document for at transaction code or amm system
I SEGMENT'="AT",SYSTEM'="AMM" S GECSFMS("DOC")=GECSFMS("DOC")_SEGMENT_"1^"_TRANCODE_"^"_DOCUMENT_"^"_SECCODE_FCPFLAG_$C(126)
; add entry and control segment to stack file
S GECSFMS("DA")=$$ADD^GECSSTAA(TRANCODE_":FMS",GECSFMS("CTL"),$G(GECSFMS("BAT")),GECSFMS("DOC"),DESCRIPT)
L -^GECS(2100.1,"AZ",STACK)
Q
;
;
TRANSMIT ; transmit fms document from file 2100 immediately without batching
; called from gecsxbl1 routine
N %,CTLDATA,DA,GECSFMS,STACK
S CTLDATA=$G(^GECS(2100,GECS("CSDA"),"FMS"))
; ctldata=trancode^transnumber^modification=Y^securitycode^fcpflag
D CONTROL("C",GECS("SITE"),$P(CTLDATA,"^",2),$P(CTLDATA,"^"),$P(CTLDATA,"^",4),$S($P(CTLDATA,"^",3)="Y":1,1:0),$P(CTLDATA,"^",5),"Create a Code Sheet Document")
S DA=0 F S DA=$O(^GECS(2100,GECS("CSDA"),"CODE",DA)) Q:'DA S %=$G(^(DA,0)) I %'="" D SETCS^GECSSTAA(GECSFMS("DA"),%)
; set status for queued task to pick up and transmit
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
; set status in file 2100
S STACK=$P($G(^GECS(2100.1,GECSFMS("DA"),0)),"^")
S $P(^GECS(2100,GECS("CSDA"),"TRANS"),"^",3)=STACK
W !!,"STACK FILE ENTRY: ",STACK,?53,"QUEUED FOR TRANSMISSION"
W !?5,"document header automatically created:",!,GECSFMS("CTL")
I $D(GECSFMS("BAT")) W !,GECSFMS("BAT")
W !,$G(GECSFMS("DOC"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSUFMS 5506 printed Dec 13, 2024@01:56:35 Page 2
GECSUFMS ;WISC/RFJ/KLD-fms utilities ;10/13/98
+1 ;;2.0;GCS;**7,8,15,19,30,31,34,40**;MAR 14, 1995;Build 13
+2 QUIT
+3 ;
+4 ;GEC*2.0*40 Modified document MOA segment to insure the
+5 ; document transaction date used was from
+6 ; Committed Date in file 410 entry and handles
+7 ; the FY/FQ correctly when date is before
+8 ; or after current FY.
+9 ;
CONTROL(SYSTEM,STATION,DOCUMENT,TRANCODE,SECCODE,MODFLAG,FCPFLAG,DESCRIPT,COMMDATE) ; return fms control segment
+1 ; system = "A" for ar, "I" for ifcap, "E" for eng, "C" for create doc
+2 ; station = 3 digit station number
+3 ; document = source document [sta-po####xx] where xx=partial (opt)
+4 ; trancode = MO, SV, etc for class = DOC
+5 ; = VR for vendor requests
+6 ; seccode = security 1 code (usually '10 ')
+7 ; modflag = 1 for modification document (batch number auto gen)
+8 ; fcpflag = Y if transaction has updated ifcap fcp balance
+9 ; use only for tran-code AR, CR, IV, MO, SA, ST
+10 ; descript = description of event
+11 ; return gecsfms("ctl"), gecsfms("bat"), gecsfms("doc")
+12 ;GEC*2.0*40
NEW %,%H,%I,BATNUMB,DATE,FY,H,M,S,SEGMENT,STACK,TIME,TRANCLAS,X,Y,SYSTEMI,GECOMDT
+13 KILL GECSFMS
+14 ; save initial system for rebuild
SET SYSTEMI=SYSTEM
+15 SET SYSTEM=$SELECT($EXTRACT(SYSTEM)="A":"ARS",$EXTRACT(SYSTEM)="I":"IFC",$EXTRACT(SYSTEM)="E":"AMM",1:"CFD")
+16 SET STATION=$EXTRACT(STATION,1,3)
+17 SET DOCUMENT=$EXTRACT($TRANSLATE(DOCUMENT,"-")_" ",1,11)
+18 SET TRANCODE=$EXTRACT(TRANCODE,1,2)
+19 SET SECCODE=$EXTRACT(SECCODE_" ",1,4)
GCOMDT ;GEC*2.0*40
DO NOW^%DTC
SET Y=%
SET (GECOMDT,DATE)=X
DO DD^%DT
+1 IF $GET(COMMDATE)
SET GECOMDT=COMMDATE
SET TIME="100000"
+2 SET %=$PIECE(Y,"@",2)
SET H=$PIECE(%,":")
SET M=$PIECE(%,":",2)
SET S=$PIECE(%,":",3)
SET H=$EXTRACT("00",$LENGTH(H)+1,2)_H
SET M=$EXTRACT("00",$LENGTH(M)+1,2)_M
SET S=$EXTRACT("00",$LENGTH(S)+1,2)_S
SET TIME=H_M_S
+3 ;GEC*2.0*40
SET Y=X
XECUTE ^DD("DD")
SET FY=$SELECT(GECOMDT>($EXTRACT(DATE,1,3)_"0930"):$EXTRACT(DATE,2,3)+1,GECOMDT<DATE:999,1:$EXTRACT(DATE,2,3))
+4 ;GEC*2.0*40
IF FY=999
Begin DoDot:1
+5 IF $EXTRACT(GECOMDT,1,3)=$EXTRACT(DATE,1,3)!((GECOMDT>($EXTRACT(DATE,1,3)-1)_"0930"))
SET FY=$EXTRACT(DATE,2,3)
QUIT
+6 IF GECOMDT>($EXTRACT(GECOMDT,1,3)_"0930")
IF GECOMDT<($EXTRACT(GECOMDT,1,3)_1232)
SET FY=$EXTRACT(GECOMDT,2,3)+1
QUIT
+7 SET FY=$EXTRACT(GECOMDT,2,3)
End DoDot:1
+8 SET STACK=TRANCODE_"-"_DOCUMENT
+9 ; check if STACK exists in 2100.1 file
+10 KILL GECSDATA
+11 DO DATA^GECSSGET(STACK,0)
+12 IF $GET(GECSDATA)>0
IF MODFLAG'>0
SET GECSTEST=GECSDATA
Begin DoDot:1
+13 ;STACK entry exists. convert CONTROL call into REBUILD call
+14 DO REBUILD^GECSUFM1(GECSDATA,SYSTEMI,SECCODE,FCPFLAG,DESCRIPT)
+15 SET DA=GECSTEST
SET GECSFMS("DA")=GECSTEST
+16 KILL GECSDATA,GECSTEST
End DoDot:1
QUIT
+17 ;
+18 IF MODFLAG
FOR
SET %=$$ACOUNTER^GECSUNUM(STATION_"-FMS:BATCH-"_FY)
SET %=$EXTRACT(%,$LENGTH(%)-2,$LENGTH(%))
SET %=$EXTRACT("000",$LENGTH(%)+1,3)_%
SET X=STACK_"-"_STATION_%
IF '$DATA(^GECS(2100.1,"B",X))
LOCK +^GECS(2100.1,"AZ",X):0
IF $TEST
SET STACK=X
QUIT
+19 SET BATNUMB=$EXTRACT($PIECE(STACK,"-",3)_" ",1,6)
+20 SET TRANCLAS="DOC"
IF TRANCODE="VR"
SET TRANCLAS="VRQ"
SET TRANCODE=" "
+21 ;GEC*2.0*40
SET GECSFMS("CTL")="CTL^"_SYSTEM_"^FMS^"_$EXTRACT(STATION,1,3)_"^"_TRANCLAS_"^"_TRANCODE_"^"_SECCODE_"^"_$EXTRACT(BATNUMB,1,6)_"^"_DOCUMENT_"^"_(17+$EXTRACT(GECOMDT))_$EXTRACT(GECOMDT,2,7)_"^"_TIME_"^001^001^001^"_$CHAR(126)
+22 ;
+23 ; vendor request, add ctl to stack and quit
+24 IF TRANCLAS="VRQ"
Begin DoDot:1
+25 SET GECSFMS("DA")=$$ADD^GECSSTAA("VR:FMS",GECSFMS("CTL"),"","",DESCRIPT)
+26 LOCK -^GECS(2100.1,"AZ",STACK)
End DoDot:1
QUIT
+27 ;
+28 ; change segment for specific transaction codes
+29 SET SEGMENT=TRANCODE
+30 IF TRANCODE="CF"!(TRANCODE="WR")!(TRANCODE="TR")
SET SEGMENT="CR"
+31 IF TRANCODE="DV"!(TRANCODE="ET")
SET SEGMENT="DD"
+32 IF TRANCODE="AO"!(TRANCODE="CO")!(TRANCODE="SO")!(TRANCODE="TG")!(TRANCODE="WO")
SET SEGMENT="MO"
+33 IF TRANCODE="AV"!(TRANCODE="CT")!(TRANCODE="MV")!(TRANCODE="OP")!(TRANCODE="PS")!(TRANCODE="TD")
SET SEGMENT="PV"
+34 IF TRANCODE="AR"!(TRANCODE="RT")
SET SEGMENT="RC"
+35 IF TRANCODE="BV"
SET SEGMENT="SV"
+36 IF TRANCODE="RO"!(TRANCODE="TZ")
SET SEGMENT="TO"
+37 IF TRANCODE="RV"!(TRANCODE="TY")
SET SEGMENT="TV"
+38 ; create bat segment
+39 IF MODFLAG
SET GECSFMS("BAT")="BAT^"_$CHAR(126)_SEGMENT_"0^"_BATNUMB_"^"_$CHAR(126)
+40 ; create doc and <tc>1 segments
+41 IF "RC^CR^TR^IV^MO^SA^ST"[SEGMENT
SET FCPFLAG=$SELECT(FCPFLAG="Y":"Y",1:"N")_"^"
+42 ; security code is not on the sa1,st1 code sheets
+43 SET SECCODE=SECCODE_"^"
+44 IF "SA^ST"[SEGMENT
SET SECCODE=""
+45 SET GECSFMS("DOC")="DOC^"_$CHAR(126)
+46 ; do not create <tc>1 document for at transaction code or amm system
+47 IF SEGMENT'="AT"
IF SYSTEM'="AMM"
SET GECSFMS("DOC")=GECSFMS("DOC")_SEGMENT_"1^"_TRANCODE_"^"_DOCUMENT_"^"_SECCODE_FCPFLAG_$CHAR(126)
+48 ; add entry and control segment to stack file
+49 SET GECSFMS("DA")=$$ADD^GECSSTAA(TRANCODE_":FMS",GECSFMS("CTL"),$GET(GECSFMS("BAT")),GECSFMS("DOC"),DESCRIPT)
+50 LOCK -^GECS(2100.1,"AZ",STACK)
+51 QUIT
+52 ;
+53 ;
TRANSMIT ; transmit fms document from file 2100 immediately without batching
+1 ; called from gecsxbl1 routine
+2 NEW %,CTLDATA,DA,GECSFMS,STACK
+3 SET CTLDATA=$GET(^GECS(2100,GECS("CSDA"),"FMS"))
+4 ; ctldata=trancode^transnumber^modification=Y^securitycode^fcpflag
+5 DO CONTROL("C",GECS("SITE"),$PIECE(CTLDATA,"^",2),$PIECE(CTLDATA,"^"),$PIECE(CTLDATA,"^",4),$SELECT($PIECE(CTLDATA,"^",3)="Y":1,1:0),$PIECE(CTLDATA,"^",5),"Create a Code Sheet Document")
+6 SET DA=0
FOR
SET DA=$ORDER(^GECS(2100,GECS("CSDA"),"CODE",DA))
if 'DA
QUIT
SET %=$GET(^(DA,0))
IF %'=""
DO SETCS^GECSSTAA(GECSFMS("DA"),%)
+7 ; set status for queued task to pick up and transmit
+8 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
+9 ; set status in file 2100
+10 SET STACK=$PIECE($GET(^GECS(2100.1,GECSFMS("DA"),0)),"^")
+11 SET $PIECE(^GECS(2100,GECS("CSDA"),"TRANS"),"^",3)=STACK
+12 WRITE !!,"STACK FILE ENTRY: ",STACK,?53,"QUEUED FOR TRANSMISSION"
+13 WRITE !?5,"document header automatically created:",!,GECSFMS("CTL")
+14 IF $DATA(GECSFMS("BAT"))
WRITE !,GECSFMS("BAT")
+15 WRITE !,$GET(GECSFMS("DOC"))
+16 QUIT
