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