source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSUFMS.m@ 1240

Last change on this file since 1240 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1GECSUFMS ;WISC/RFJ/KLD-fms utilities ;10/13/98
2 ;;2.0;GCS;**7,8,15,19,30,31,34**;MAR 14, 1995
3 Q
4 ;
5 ;
6CONTROL(SYSTEM,STATION,DOCUMENT,TRANCODE,SECCODE,MODFLAG,FCPFLAG,DESCRIPT) ; return fms control segment
7 ; system = "A" for ar, "I" for ifcap, "E" for eng, "C" for create doc
8 ; station = 3 digit station number
9 ; document = source document [sta-po####xx] where xx=partial (opt)
10 ; trancode = MO, SV, etc for class = DOC
11 ; = VR for vendor requests
12 ; seccode = security 1 code (usually '10 ')
13 ; modflag = 1 for modification document (batch number auto gen)
14 ; fcpflag = Y if transaction has updated ifcap fcp balance
15 ; use only for tran-code AR, CR, IV, MO, SA, ST
16 ; descript = description of event
17 ; return gecsfms("ctl"), gecsfms("bat"), gecsfms("doc")
18 N %,%H,%I,BATNUMB,DATE,FY,H,M,S,SEGMENT,STACK,TIME,TRANCLAS,X,Y,SYSTEMI
19 K GECSFMS
20 S SYSTEMI=SYSTEM ; save initial system for rebuild
21 S SYSTEM=$S($E(SYSTEM)="A":"ARS",$E(SYSTEM)="I":"IFC",$E(SYSTEM)="E":"AMM",1:"CFD")
22 S STATION=$E(STATION,1,3)
23 S DOCUMENT=$E($TR(DOCUMENT,"-")_" ",1,11)
24 S TRANCODE=$E(TRANCODE,1,2)
25 S SECCODE=$E(SECCODE_" ",1,4)
26 D NOW^%DTC S Y=%,DATE=X D DD^%DT
27 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
28 S Y=X X ^DD("DD") S FY=$S($E(DATE,4,5)<10:$E(DATE,2,3),1:$P(Y,",",2)+1)
29 S STACK=TRANCODE_"-"_DOCUMENT
30 ; check if STACK exists in 2100.1 file
31 K GECSDATA
32 D DATA^GECSSGET(STACK,0)
33 I $G(GECSDATA)>0,MODFLAG'>0 S GECSTEST=GECSDATA D Q
34 . ;STACK entry exists. convert CONTROL call into REBUILD call
35 . D REBUILD^GECSUFM1(GECSDATA,SYSTEMI,SECCODE,FCPFLAG,DESCRIPT)
36 . S DA=GECSTEST,GECSFMS("DA")=GECSTEST
37 . K GECSDATA,GECSTEST
38 ;
39 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
40 S BATNUMB=$E($P(STACK,"-",3)_" ",1,6)
41 S TRANCLAS="DOC" I TRANCODE="VR" S TRANCLAS="VRQ",TRANCODE=" "
42 S GECSFMS("CTL")="CTL^"_SYSTEM_"^FMS^"_$E(STATION,1,3)_"^"_TRANCLAS_"^"_TRANCODE_"^"_SECCODE_"^"_$E(BATNUMB,1,6)_"^"_DOCUMENT_"^"_(17+$E(DATE))_$E(DATE,2,7)_"^"_TIME_"^001^001^001^"_$C(126)
43 ;
44 ; vendor request, add ctl to stack and quit
45 I TRANCLAS="VRQ" D Q
46 . S GECSFMS("DA")=$$ADD^GECSSTAA("VR:FMS",GECSFMS("CTL"),"","",DESCRIPT)
47 . L -^GECS(2100.1,"AZ",STACK)
48 ;
49 ; change segment for specific transaction codes
50 S SEGMENT=TRANCODE
51 I TRANCODE="CF"!(TRANCODE="WR")!(TRANCODE="TR") S SEGMENT="CR"
52 I TRANCODE="DV"!(TRANCODE="ET") S SEGMENT="DD"
53 I TRANCODE="AO"!(TRANCODE="CO")!(TRANCODE="SO")!(TRANCODE="TG")!(TRANCODE="WO") S SEGMENT="MO"
54 I TRANCODE="AV"!(TRANCODE="CT")!(TRANCODE="MV")!(TRANCODE="OP")!(TRANCODE="PS")!(TRANCODE="TD") S SEGMENT="PV"
55 I TRANCODE="AR"!(TRANCODE="RT") S SEGMENT="RC"
56 I TRANCODE="BV" S SEGMENT="SV"
57 I TRANCODE="RO"!(TRANCODE="TZ") S SEGMENT="TO"
58 I TRANCODE="RV"!(TRANCODE="TY") S SEGMENT="TV"
59 ; create bat segment
60 I MODFLAG S GECSFMS("BAT")="BAT^"_$C(126)_SEGMENT_"0^"_BATNUMB_"^"_$C(126)
61 ; create doc and <tc>1 segments
62 I "RC^CR^TR^IV^MO^SA^ST"[SEGMENT S FCPFLAG=$S(FCPFLAG="Y":"Y",1:"N")_"^"
63 ; security code is not on the sa1,st1 code sheets
64 S SECCODE=SECCODE_"^"
65 I "SA^ST"[SEGMENT S SECCODE=""
66 S GECSFMS("DOC")="DOC^"_$C(126)
67 ; do not create <tc>1 document for at transaction code or amm system
68 I SEGMENT'="AT",SYSTEM'="AMM" S GECSFMS("DOC")=GECSFMS("DOC")_SEGMENT_"1^"_TRANCODE_"^"_DOCUMENT_"^"_SECCODE_FCPFLAG_$C(126)
69 ; add entry and control segment to stack file
70 S GECSFMS("DA")=$$ADD^GECSSTAA(TRANCODE_":FMS",GECSFMS("CTL"),$G(GECSFMS("BAT")),GECSFMS("DOC"),DESCRIPT)
71 L -^GECS(2100.1,"AZ",STACK)
72 Q
73 ;
74 ;
75TRANSMIT ; transmit fms document from file 2100 immediately without batching
76 ; called from gecsxbl1 routine
77 N %,CTLDATA,DA,GECSFMS,STACK
78 S CTLDATA=$G(^GECS(2100,GECS("CSDA"),"FMS"))
79 ; ctldata=trancode^transnumber^modification=Y^securitycode^fcpflag
80 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")
81 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"),%)
82 ; set status for queued task to pick up and transmit
83 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
84 ; set status in file 2100
85 S STACK=$P($G(^GECS(2100.1,GECSFMS("DA"),0)),"^")
86 S $P(^GECS(2100,GECS("CSDA"),"TRANS"),"^",3)=STACK
87 W !!,"STACK FILE ENTRY: ",STACK,?53,"QUEUED FOR TRANSMISSION"
88 W !?5,"document header automatically created:",!,GECSFMS("CTL")
89 I $D(GECSFMS("BAT")) W !,GECSFMS("BAT")
90 W !,$G(GECSFMS("DOC"))
91 Q
Note: See TracBrowser for help on using the repository browser.