Enkele routines, wordt gebruikt in meerdere BL objecten UglyPickingCNTs BL.Lib.BaseObj 0 1 code LocM:%Library.String,LocG:%Library.String,LocX:%Library.String,LocY:%Library.String,LocZ:%Library.String,ScanVersion:%Library.Boolean=0,IncludeLocZ:%Library.Boolean=0 cache 0 %Library.String 1 code cache 0 %Library.String 1 code cache 0 %Library.String "_$LI(FoundLocation,5)_")." Quit Status ]]> 1 code VerwerkingSoftware:%Library.Persistent %Library.String 1 code cache 0 %Library.String Result=' 5 9999999K...' record, kan in een bestand geschreven worden New RecCode,D Set RecCode=Ref ;S01,C01,T01... Set RefToRec=RecCode Quit:(VolgNrRequired && ('$D(Ref("VOLGNR")))) "" Do:(VolgNrRequired) ADDNUM(.RefToRec,Ref("VOLGNR"),10,0) Set D="\" New Loop,DRec,FieldName,Value,Len,Type Set Loop="" For Set Loop=$O(^EWREC("D",RecCode,Loop)) Quit:(Loop="") Do . Set DRec=^EWREC("D",RecCode,Loop) . Set FieldName=$P(DRec,D,1) ;eg "DELTA", "PALETID" . Set Value=Ref(FieldName) ;eg 5,"9999999K" . Set Len=$P(DRec,D,2) ;vastgelegd door ^EWREC("D",RecCode) . Set Type=$P(DRec,D,3) ;vastgelegd door ^EWREC("D",RecCode) . If Type="N" Do ADDNUM(.RefToRec,Value,Len\1,$P(Len,".",2)) Quit . If Type="DT" Do ADDDAT(.RefToRec,Value,Len) Quit . If Type="TD" Do ADDTIME(.RefToRec,Value,Len) Quit . Do ADDALFA(.RefToRec,Value,Len) Set RefToRec=RefToRec New Status Set Status=$LB(0) ;neutraal Set:($G(RecFileName)'="") Status=##class(BL.MB.UGLYPicking.General).FEWMSRecsToFile($LB(RefToRec),RecFileName) Quit:($LI(Status)<0) "" ;Bij fout: leeg teruggeven... Quit RefToRec //-------------------------------------------------------------------------------------------------------------- ADDALFA(Rec,Value,Len) Set Rec=Rec_$E(Value,1,Len)_$J("",Len-$L(Value)) Quit ADDNUM(Rec,Value,Len,Dec) New Value1,Value2 Set Value=$J(+Value,0,Dec) If Dec Do . Set Value1=Value\1 . Set Value2=Value-Value1*(10**Dec) . Set Rec=Rec_$J("",Len-$L(Value1))_$E(Value1,1,Len) . Set Rec=Rec_$E($TR($J(Value2,Dec)," ",0),1,Dec) Else Do . Set Rec=Rec_$J("",Len-$L(Value))_$E(Value,1,Len) Quit ADDDAT(Rec,Value,Len) ; Omzetten van Datum of Datum en Tijd New Dat,Tijd If +$P(Value,".")=0 Set Dat="00000000" Else Set Dat=$$EXTDATE^vhDTyp(Value,"J4")_$E(100+$$EXTDATE^vhDTyp(Value,"MN"),2,3)_$E(100+$$EXTDATE^vhDTyp(Value,"DMN"),2,3) If +$P(Value,".",2) Set Tijd="000000" Else Do . Set Tijd=$$EXTTIME^vhDTyp($P(Value,",",2),"TKS") . Set Dat=Dat_$E(100+$P(Tijd,":",1),2,3)_$E(100+$P(Tijd,":",2),2,3)_$E(100+$P(Tijd,":",3),2,3) Set Rec=Rec_$J("",Len-$L(Dat))_$E(Dat,1,Len) Quit ADDTIME(Rec,Value,Len) ; Omzetten van Tijd New Tijd If +$P(Value,".",2) Set Tijd="000000" Else Do . Set Tijd=$$EXTTIME^vhDTyp($P(Value,",",2),"TKS") . Set Tijd=$E(100+$P(Tijd,":",1),2,3)_$E(100+$P(Tijd,":",2),2,3)_$E(100+$P(Tijd,":",3),2,3) Set Rec=Rec_$J("",Len-$L(Tijd))_$E(Tijd,1,Len) Quit ]]> 1 code lbRecs:%Library.List,RecFileName:%Library.String cache 0 %Library.List 1 code ProductORef:%Library.Integer cache 0 %Library.String 1 code ProductNr:%Library.Integer cache 0 %Library.Boolean 1 code ProductNr:%Library.Integer,DefMag:%Library.String cache 0 %Library.Boolean 1 code %Library.List 1 code %Library.Boolean '00000000') AND (qty_picked=0) AND (qty_allocated>0) AND (insert_time > '2003-04-15%') GROUP BY present_loc_m) &sql(OPEN crECNT) If ((SQLCODE<0) || ($L($G(%msg)))) Quit 0 New FatalErr Set FatalErr=0 For &sql(FETCH crECNT) Quit:(SQLCODE || FatalErr) Do . If ((SQLCODE<0) || ($L($G(%msg)))) Do Quit .. Set FatalErr=1 //One LVL down . Set @arefECNT@(PresentLocM)=PresentLocMCnt Quit:(FatalErr) 0 &sql(CLOSE crECNT) Quit 1 ]]> 1 LocM:%String,LocG:%String,LocX:%String,LocY:%String cache 1 %String 1 code LocationsID:%Library.String cache 0 1 code LocID:%Library.String,ScanVersion:%Library.Boolean=0 cache 0 %Library.String 1 code LocationsObj:EWMS.Locations cache 0 1 code ScannedLocation:%Library.String cache 0 %Library.List 1 code LocID:%Library.String cache 0 %Library.List 1 code cache 0 %Library.String 1 code %Integer 9999999) CVolgNr=0 Set ^EWREC("UPC")=CVolgNr Quit CVolgNr ]]> Standaard geeft deze het ReceptieNummer terug. Behalve als de subnode in ^RCP niet bestaat, dan wordt een extra "0" achteraan toegevoegd. Uitleg PaulV. 1 ReceptieNummer:%String,Bonnummer:%String="" 1 %String 1 expression PalletID:%String %Boolean 1 PalletID:%String %String 8) { Quit $E(PalletID,1,3)_$E(PalletID,$L(PalletID)-4,$L(PalletID)) } Quit PalletID ]]> 1 PalletID:%String %String 1 code Location:%Library.List cache 0 %Library.String 1 Location:%Library.List cache 1 %Library.String 1 code LocationsID:%Library.String cache 0 1 code LocM:%Library.Integer cache 0 %Library.String 1 code Location:%Library.List cache 0 %Library.String 1 code LocM:%Library.Integer cache 0 %Library.String 1 code Directory:%String,BaseFileName:%String %Library.String 1 code LocM:%Library.String %Library.Boolean 1 LocM:%Library.String %Library.Boolean 1 LocM:%Library.String %Library.Boolean 1 LocM:%Library.String %Library.Boolean 1 code Magazijn:%Library.String %Library.String 1 code C %String Te oude entries verwijderen 1 code 1 code Msg:%String,Data:%String="",AtEnd:%Boolean=0 magazijn bijv O->Orgalux, H->Halux, ...]]> 1 code VerwerkingSoftware:%Library.Persistent %Library.String 1 ProductNr:%String %String QtyTransported)) &sql(OPEN crTR) &sql(FETCH crTR) Set:($D(OrderNr)) Status=Status_"R" &sql(CLOSE crTR) ; ====== To_Pick ====== k OrderNr &sql(DECLARE crTP CURSOR FOR SELECT order_nr INTO :OrderNr FROM EWMS_Pick.ToPick WHERE (product=:ProductNr) AND (qty_to_pick <> qty_picked)) &sql(OPEN crTP) &sql(FETCH crTP) Set:($D(OrderNr)) Status=Status_"P" &sql(CLOSE crTP) ; ====== Inventory ====== &sql(DECLARE crI CURSOR FOR SELECT loc_id INTO :LocID FROM EWMS.Inventory WHERE (product=:ProductNr) AND (loc_m<5)) &sql(OPEN crI) &sql(FETCH crI) Set:($D(LocID)) Status=Status_"I" &sql(CLOSE crI) Quit Status ]]> 1 ProductNr:%String %String